Removed Web.Mime
This commit is contained in:
parent
d385fc48d1
commit
cda45d2837
122
Web/Mime.hs
122
Web/Mime.hs
@ -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
|
|
||||||
6
Yesod.hs
6
Yesod.hs
@ -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
|
||||||
|
|||||||
118
Yesod/Content.hs
118
Yesod/Content.hs
@ -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
|
||||||
|
|||||||
@ -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)
|
||||||
|
|
||||||
|
|||||||
@ -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)
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
@ -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
|
||||||
]
|
]
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user