From cda45d28374702d3e62c471cab5d78dd1394e5d0 Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Tue, 11 May 2010 23:23:07 +0300 Subject: [PATCH] Removed Web.Mime --- Web/Mime.hs | 122 ---------------------------------------------- Yesod.hs | 6 +-- Yesod/Content.hs | 118 +++++++++++++++++++++++++++++++++++++++++++- Yesod/Dispatch.hs | 1 - Yesod/Handler.hs | 1 - Yesod/Json.hs | 4 +- runtests.hs | 4 +- yesod.cabal | 1 - 8 files changed, 124 insertions(+), 133 deletions(-) delete mode 100644 Web/Mime.hs diff --git a/Web/Mime.hs b/Web/Mime.hs deleted file mode 100644 index d774e32c..00000000 --- a/Web/Mime.hs +++ /dev/null @@ -1,122 +0,0 @@ -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE CPP #-} --- | Generic MIME type module. Could be spun off into its own package. -module Web.Mime - ( -- * Data type and conversions - ContentType (..) - , contentTypeFromString - , contentTypeToString - -- * File extensions - , typeByExt - , ext - -- * Utilities - , simpleContentType -#if TEST - , testSuite -#endif - ) where - -import Data.Function (on) - -#if TEST -import Test.Framework (testGroup, Test) -import Test.Framework.Providers.HUnit -import Test.Framework.Providers.QuickCheck2 (testProperty) -import Test.HUnit hiding (Test) -#endif - --- | Equality is determined by converting to a 'String' via --- 'contentTypeToString'. This ensures that, for example, 'TypeJpeg' is the --- same as 'TypeOther' \"image/jpeg\". However, note that 'TypeHtml' is *not* --- the same as 'TypeOther' \"text/html\", since 'TypeHtml' is defined as UTF-8 --- encoded. See 'contentTypeToString'. -data ContentType = - TypeHtml - | TypePlain - | TypeJson - | TypeXml - | TypeAtom - | TypeJpeg - | TypePng - | TypeGif - | TypeJavascript - | TypeCss - | TypeFlv - | TypeOgv - | TypeOctet - | TypeOther String - deriving (Show) - --- | This is simply a synonym for 'TypeOther'. However, equality works as --- expected; see 'ContentType'. -contentTypeFromString :: String -> ContentType -contentTypeFromString = TypeOther - --- | This works as expected, with one caveat: the builtin textual content types --- ('TypeHtml', 'TypePlain', etc) all include \"; charset=utf-8\" at the end of --- their basic content-type. If another encoding is desired, please use --- 'TypeOther'. -contentTypeToString :: ContentType -> String -contentTypeToString TypeHtml = "text/html; charset=utf-8" -contentTypeToString TypePlain = "text/plain; charset=utf-8" -contentTypeToString TypeJson = "application/json; charset=utf-8" -contentTypeToString TypeXml = "text/xml" -contentTypeToString TypeAtom = "application/atom+xml" -contentTypeToString TypeJpeg = "image/jpeg" -contentTypeToString TypePng = "image/png" -contentTypeToString TypeGif = "image/gif" -contentTypeToString TypeJavascript = "text/javascript; charset=utf-8" -contentTypeToString TypeCss = "text/css; charset=utf-8" -contentTypeToString TypeFlv = "video/x-flv" -contentTypeToString TypeOgv = "video/ogg" -contentTypeToString TypeOctet = "application/octet-stream" -contentTypeToString (TypeOther s) = s - --- | Removes \"extra\" information at the end of a content type string. In --- particular, removes everything after the semicolon, if present. --- --- For example, \"text/html; charset=utf-8\" is commonly used to specify the --- character encoding for HTML data. This function would return \"text/html\". -simpleContentType :: String -> String -simpleContentType = fst . span (/= ';') - -instance Eq ContentType where - (==) = (==) `on` contentTypeToString - --- | 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 - -#if TEST ----- Testing -testSuite :: Test -testSuite = testGroup "Yesod.Resource" - [ testProperty "ext" propExt - , testCase "typeByExt" caseTypeByExt - ] - -propExt :: String -> Bool -propExt s = - let s' = filter (/= '.') s - in s' == ext ("foobarbaz." ++ s') - -caseTypeByExt :: Assertion -caseTypeByExt = do - TypeJavascript @=? typeByExt (ext "foo.js") - TypeHtml @=? typeByExt (ext "foo.html") -#endif diff --git a/Yesod.hs b/Yesod.hs index 1e9ecb3e..73e5f2d2 100644 --- a/Yesod.hs +++ b/Yesod.hs @@ -8,7 +8,6 @@ module Yesod , module Yesod.Handler , module Yesod.Dispatch , module Yesod.Form - , module Web.Mime , module Yesod.Hamlet , module Yesod.Json , Application @@ -18,14 +17,13 @@ module Yesod ) where #if TEST -import Web.Mime hiding (testSuite) +import Yesod.Content hiding (testSuite) import Yesod.Json hiding (testSuite) #else -import Web.Mime +import Yesod.Content import Yesod.Json #endif -import Yesod.Content import Yesod.Request import Yesod.Dispatch import Yesod.Form diff --git a/Yesod/Content.hs b/Yesod/Content.hs index dfafc456..c622db4b 100644 --- a/Yesod/Content.hs +++ b/Yesod/Content.hs @@ -4,11 +4,22 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE Rank2Types #-} +{-# LANGUAGE CPP #-} module Yesod.Content ( -- * Content Content (..) , toContent + -- * Mime types + -- ** Data type + , ContentType (..) + , contentTypeFromString + , contentTypeToString + -- ** File extensions + , typeByExt + , ext + -- * Utilities + , simpleContentType -- * Representations , ChooseRep , HasReps (..) @@ -19,6 +30,9 @@ module Yesod.Content , RepHtmlJson (..) , RepPlain (..) , RepXml (..) +#if TEST + , testSuite +#endif ) where import Data.Maybe (mapMaybe) @@ -31,7 +45,14 @@ import Data.Convertible.Text import qualified Network.Wai as W import qualified Network.Wai.Enumerator as WE -import Web.Mime +import Data.Function (on) + +#if TEST +import Test.Framework (testGroup, Test) +import Test.Framework.Providers.HUnit +import Test.Framework.Providers.QuickCheck2 (testProperty) +import Test.HUnit hiding (Test) +#endif -- | There are two different methods available for providing content in the -- response: via files and enumerators. The former allows server to use @@ -129,3 +150,98 @@ instance HasReps RepPlain where newtype RepXml = RepXml Content instance HasReps RepXml where chooseRep (RepXml c) _ = return (TypeXml, c) + +-- | Equality is determined by converting to a 'String' via +-- 'contentTypeToString'. This ensures that, for example, 'TypeJpeg' is the +-- same as 'TypeOther' \"image/jpeg\". However, note that 'TypeHtml' is *not* +-- the same as 'TypeOther' \"text/html\", since 'TypeHtml' is defined as UTF-8 +-- encoded. See 'contentTypeToString'. +data ContentType = + TypeHtml + | TypePlain + | TypeJson + | TypeXml + | TypeAtom + | TypeJpeg + | TypePng + | TypeGif + | TypeJavascript + | TypeCss + | TypeFlv + | TypeOgv + | TypeOctet + | TypeOther String + deriving (Show) + +-- | This is simply a synonym for 'TypeOther'. However, equality works as +-- expected; see 'ContentType'. +contentTypeFromString :: String -> ContentType +contentTypeFromString = TypeOther + +-- | This works as expected, with one caveat: the builtin textual content types +-- ('TypeHtml', 'TypePlain', etc) all include \"; charset=utf-8\" at the end of +-- their basic content-type. If another encoding is desired, please use +-- 'TypeOther'. +contentTypeToString :: ContentType -> String +contentTypeToString TypeHtml = "text/html; charset=utf-8" +contentTypeToString TypePlain = "text/plain; charset=utf-8" +contentTypeToString TypeJson = "application/json; charset=utf-8" +contentTypeToString TypeXml = "text/xml" +contentTypeToString TypeAtom = "application/atom+xml" +contentTypeToString TypeJpeg = "image/jpeg" +contentTypeToString TypePng = "image/png" +contentTypeToString TypeGif = "image/gif" +contentTypeToString TypeJavascript = "text/javascript; charset=utf-8" +contentTypeToString TypeCss = "text/css; charset=utf-8" +contentTypeToString TypeFlv = "video/x-flv" +contentTypeToString TypeOgv = "video/ogg" +contentTypeToString TypeOctet = "application/octet-stream" +contentTypeToString (TypeOther s) = s + +-- | Removes \"extra\" information at the end of a content type string. In +-- particular, removes everything after the semicolon, if present. +-- +-- For example, \"text/html; charset=utf-8\" is commonly used to specify the +-- character encoding for HTML data. This function would return \"text/html\". +simpleContentType :: String -> String +simpleContentType = fst . span (/= ';') + +instance Eq ContentType where + (==) = (==) `on` contentTypeToString + +-- | 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 + +#if TEST +---- Testing +testSuite :: Test +testSuite = testGroup "Yesod.Resource" + [ testProperty "ext" propExt + , testCase "typeByExt" caseTypeByExt + ] + +propExt :: String -> Bool +propExt s = + let s' = filter (/= '.') s + in s' == ext ("foobarbaz." ++ s') + +caseTypeByExt :: Assertion +caseTypeByExt = do + TypeJavascript @=? typeByExt (ext "foo.js") + TypeHtml @=? typeByExt (ext "foo.html") +#endif diff --git a/Yesod/Dispatch.hs b/Yesod/Dispatch.hs index eaf56ab8..dc0cb422 100644 --- a/Yesod/Dispatch.hs +++ b/Yesod/Dispatch.hs @@ -35,7 +35,6 @@ import System.Environment (getEnvironment) import qualified Data.ByteString.Char8 as B import Web.Encodings -import Web.Mime import Data.List (intercalate) import Web.Routes (encodePathInfo, decodePathInfo) diff --git a/Yesod/Handler.hs b/Yesod/Handler.hs index a9fb2325..97a37d49 100644 --- a/Yesod/Handler.hs +++ b/Yesod/Handler.hs @@ -67,7 +67,6 @@ import Prelude hiding (catch) import Yesod.Request import Yesod.Content import Yesod.Internal -import Web.Mime import Web.Routes.Quasi (Routes) import Data.List (foldl') import Web.Encodings (encodeUrlPairs) diff --git a/Yesod/Json.hs b/Yesod/Json.hs index 44b56fc5..71894f44 100644 --- a/Yesod/Json.hs +++ b/Yesod/Json.hs @@ -25,7 +25,6 @@ import Web.Encodings import Yesod.Hamlet import Control.Monad (when) import Yesod.Handler -import Yesod.Content import Web.Routes.Quasi (Routes) #if TEST @@ -33,6 +32,9 @@ import Test.Framework (testGroup, Test) import Test.Framework.Providers.HUnit import Test.HUnit hiding (Test) import Data.Text.Lazy (unpack) +import Yesod.Content hiding (testSuite) +#else +import Yesod.Content #endif -- | A monad for generating Json output. In truth, it is just a newtype wrapper diff --git a/runtests.hs b/runtests.hs index 94e448e5..59000fc0 100644 --- a/runtests.hs +++ b/runtests.hs @@ -1,10 +1,10 @@ import Test.Framework (defaultMain) -import qualified Web.Mime +import qualified Yesod.Content import qualified Yesod.Json main :: IO () main = defaultMain - [ Web.Mime.testSuite + [ Yesod.Content.testSuite , Yesod.Json.testSuite ] diff --git a/yesod.cabal b/yesod.cabal index 28170733..72b7720c 100644 --- a/yesod.cabal +++ b/yesod.cabal @@ -50,7 +50,6 @@ library Yesod.Helpers.Auth Yesod.Helpers.Sitemap Yesod.Helpers.Static - Web.Mime ghc-options: -Wall executable runtests