Symantic/HTTP/Media.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2 module Symantic.HTTP.Media where
   3
   4 import Data.Function (($))
   5 import Data.Proxy (Proxy(..))
   6 import qualified Network.HTTP.Media as Media
   7
   8 -- * Class 'MediaTypeable'
   9 class MediaTypeable mt where
  10         mediaType  :: Proxy mt -> MediaType
  11         mediaTypes :: Proxy mt -> [MediaType]
  12         mediaTypes mt = [mediaType mt]
  13 type MediaType = Media.MediaType
  14
  15 charsetUTF8 :: MediaType -> MediaType
  16 charsetUTF8 = (Media./: ("charset", "utf-8"))
  17
  18 mimeAny :: MediaType
  19 mimeAny = "*/*"
  20
  21 -- ** Type 'JSON'
  22 data JSON
  23 mimeJSON :: Proxy JSON
  24 mimeJSON = Proxy
  25 instance MediaTypeable JSON where
  26         mediaType _mt = charsetUTF8 $ "application"Media.//"json"
  27         mediaTypes mt = [mediaType mt, "application"Media.//"json"]
  28
  29 -- ** Type 'HTML'
  30 data HTML
  31 mimeHTML :: Proxy HTML
  32 mimeHTML = Proxy
  33 instance MediaTypeable HTML where
  34         mediaType _mt = charsetUTF8 $ "text"Media.//"html"
  35         mediaTypes mt = [mediaType mt, "text"Media.//"html"]
  36
  37 -- ** Type 'FormUrlEncoded'
  38 data FormUrlEncoded
  39 mimeFormUrlEncoded :: Proxy FormUrlEncoded
  40 mimeFormUrlEncoded = Proxy
  41 instance MediaTypeable FormUrlEncoded where
  42         mediaType _mt = "application"Media.//"x-www-form-urlencoded"
  43
  44 -- ** Type 'OctetStream'
  45 data OctetStream
  46 mimeOctetStream :: Proxy OctetStream
  47 mimeOctetStream = Proxy
  48 instance MediaTypeable OctetStream where
  49         mediaType _mt = "application"Media.//"octet-stream"
  50
  51 -- ** Type 'PlainText'
  52 data PlainText
  53 mimePlainText :: Proxy PlainText
  54 mimePlainText = Proxy
  55 instance MediaTypeable PlainText where
  56         mediaType _mt = charsetUTF8 $ "text"Media.//"plain"
  57 instance MediaTypeable () where
  58         mediaType _mt = mediaType mimePlainText