Removed Web.Mime

This commit is contained in:
Michael Snoyman 2010-05-11 23:23:07 +03:00
parent d385fc48d1
commit cda45d2837
8 changed files with 124 additions and 133 deletions

View File

@ -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

View File

@ -8,7 +8,6 @@ module Yesod
, module Yesod.Handler , module Yesod.Handler
, module Yesod.Dispatch , module Yesod.Dispatch
, module Yesod.Form , module Yesod.Form
, module Web.Mime
, module Yesod.Hamlet , module Yesod.Hamlet
, module Yesod.Json , module Yesod.Json
, Application , Application
@ -18,14 +17,13 @@ module Yesod
) where ) where
#if TEST #if TEST
import Web.Mime hiding (testSuite) import Yesod.Content hiding (testSuite)
import Yesod.Json hiding (testSuite) import Yesod.Json hiding (testSuite)
#else #else
import Web.Mime import Yesod.Content
import Yesod.Json import Yesod.Json
#endif #endif
import Yesod.Content
import Yesod.Request import Yesod.Request
import Yesod.Dispatch import Yesod.Dispatch
import Yesod.Form import Yesod.Form

View File

@ -4,11 +4,22 @@
{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE Rank2Types #-} {-# LANGUAGE Rank2Types #-}
{-# LANGUAGE CPP #-}
module Yesod.Content module Yesod.Content
( -- * Content ( -- * Content
Content (..) Content (..)
, toContent , toContent
-- * Mime types
-- ** Data type
, ContentType (..)
, contentTypeFromString
, contentTypeToString
-- ** File extensions
, typeByExt
, ext
-- * Utilities
, simpleContentType
-- * Representations -- * Representations
, ChooseRep , ChooseRep
, HasReps (..) , HasReps (..)
@ -19,6 +30,9 @@ module Yesod.Content
, RepHtmlJson (..) , RepHtmlJson (..)
, RepPlain (..) , RepPlain (..)
, RepXml (..) , RepXml (..)
#if TEST
, testSuite
#endif
) where ) where
import Data.Maybe (mapMaybe) import Data.Maybe (mapMaybe)
@ -31,7 +45,14 @@ import Data.Convertible.Text
import qualified Network.Wai as W import qualified Network.Wai as W
import qualified Network.Wai.Enumerator as WE 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 -- | There are two different methods available for providing content in the
-- response: via files and enumerators. The former allows server to use -- response: via files and enumerators. The former allows server to use
@ -129,3 +150,98 @@ instance HasReps RepPlain where
newtype RepXml = RepXml Content newtype RepXml = RepXml Content
instance HasReps RepXml where instance HasReps RepXml where
chooseRep (RepXml c) _ = return (TypeXml, c) 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

View File

@ -35,7 +35,6 @@ import System.Environment (getEnvironment)
import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Char8 as B
import Web.Encodings import Web.Encodings
import Web.Mime
import Data.List (intercalate) import Data.List (intercalate)
import Web.Routes (encodePathInfo, decodePathInfo) import Web.Routes (encodePathInfo, decodePathInfo)

View File

@ -67,7 +67,6 @@ import Prelude hiding (catch)
import Yesod.Request import Yesod.Request
import Yesod.Content import Yesod.Content
import Yesod.Internal import Yesod.Internal
import Web.Mime
import Web.Routes.Quasi (Routes) import Web.Routes.Quasi (Routes)
import Data.List (foldl') import Data.List (foldl')
import Web.Encodings (encodeUrlPairs) import Web.Encodings (encodeUrlPairs)

View File

@ -25,7 +25,6 @@ import Web.Encodings
import Yesod.Hamlet import Yesod.Hamlet
import Control.Monad (when) import Control.Monad (when)
import Yesod.Handler import Yesod.Handler
import Yesod.Content
import Web.Routes.Quasi (Routes) import Web.Routes.Quasi (Routes)
#if TEST #if TEST
@ -33,6 +32,9 @@ import Test.Framework (testGroup, Test)
import Test.Framework.Providers.HUnit import Test.Framework.Providers.HUnit
import Test.HUnit hiding (Test) import Test.HUnit hiding (Test)
import Data.Text.Lazy (unpack) import Data.Text.Lazy (unpack)
import Yesod.Content hiding (testSuite)
#else
import Yesod.Content
#endif #endif
-- | A monad for generating Json output. In truth, it is just a newtype wrapper -- | A monad for generating Json output. In truth, it is just a newtype wrapper

View File

@ -1,10 +1,10 @@
import Test.Framework (defaultMain) import Test.Framework (defaultMain)
import qualified Web.Mime import qualified Yesod.Content
import qualified Yesod.Json import qualified Yesod.Json
main :: IO () main :: IO ()
main = defaultMain main = defaultMain
[ Web.Mime.testSuite [ Yesod.Content.testSuite
, Yesod.Json.testSuite , Yesod.Json.testSuite
] ]

View File

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