@@ -1,29 +1,30 @@
1−{-# LANGUAGE DeriveDataTypeable #-}
2−{-# LANGUAGE DataKinds #-}
3−{-# LANGUAGE ConstraintKinds #-}
4−{-# LANGUAGE FlexibleInstances #-}
1+{-# LANGUAGE ConstraintKinds #-}
2+{-# LANGUAGE DataKinds #-}
3+{-# LANGUAGE DeriveDataTypeable #-}
4+{-# LANGUAGE FlexibleInstances #-}
55{-# LANGUAGE MultiParamTypeClasses #-}
6−{-# LANGUAGE OverloadedStrings #-}
7−{-# LANGUAGE PolyKinds #-}
8−{-# LANGUAGE ScopedTypeVariables #-}
9−{-# LANGUAGE TypeFamilies #-}
10−{-# LANGUAGE TypeOperators #-}
11−{-# LANGUAGE UndecidableInstances #-}
6+{-# LANGUAGE OverloadedStrings #-}
7+{-# LANGUAGE PolyKinds #-}
8+{-# LANGUAGE ScopedTypeVariables #-}
9+{-# LANGUAGE TypeFamilies #-}
10+{-# LANGUAGE TypeOperators #-}
11+{-# LANGUAGE UndecidableInstances #-}
1212module Servant.API.ContentTypes where
1313
14+import Control.Arrow (left)
15+import Data.Aeson (FromJSON, ToJSON, eitherDecode,
16+ encode)
1417import qualified Data.ByteString as BS
1518import Data.ByteString.Lazy (ByteString)
1619import Data.String.Conversions (cs)
20+import qualified Data.Text.Lazy as Text
21+import qualified Data.Text.Lazy.Encoding as Text
1722import Data.Typeable
1823import GHC.Exts (Constraint)
1924import qualified Network.HTTP.Media as M
2025
2126-- * Provided content types
22−data XML deriving Typeable
23−data HTML deriving Typeable
2427data JSON deriving Typeable
25−data JavaScript deriving Typeable
26−data CSS deriving Typeable
2728data PlainText deriving Typeable
2829data OctetStream deriving Typeable
2930
@@ -41,26 +42,10 @@ data OctetStream deriving Typeable
4142class Accept ctype where
4243 contentType :: Proxy ctype -> M.MediaType
4344
44−-- | @text/html;charset=utf-8@
45−instance Accept HTML where
46− contentType _ = "text" M.// "html" M./: ("charset", "utf-8")
47−
4845-- | @application/json;charset=utf-8@
4946instance Accept JSON where
5047 contentType _ = "application" M.// "json" M./: ("charset", "utf-8")
5148
52−-- | @application/xml;charset=utf-8@
53−instance Accept XML where
54− contentType _ = "application" M.// "xml" M./: ("charset", "utf-8")
55−
56−-- | @application/javascript;charset=utf-8@
57−instance Accept JavaScript where
58− contentType _ = "application" M.// "javascript" M./: ("charset", "utf-8")
59−
60−-- | @text/css;charset=utf-8@
61−instance Accept CSS where
62− contentType _ = "text" M.// "css" M./: ("charset", "utf-8")
63−
6449-- | @text/plain;charset=utf-8@
6550instance Accept PlainText where
6651 contentType _ = "text" M.// "plain" M./: ("charset", "utf-8")
@@ -168,3 +153,34 @@ instance ( MimeUnrender ctyp a
168153
169154type family IsNonEmpty (ls::[*]) :: Constraint where
170155 IsNonEmpty (x ': xs) = ()
156+
157+
158+--------------------------------------------------------------------------
159+-- * MimeRender Instances
160+
161+-- | `encode`
162+instance ToJSON a => MimeRender JSON a where
163+ toByteString _ = encode
164+
165+-- | `Text.encodeUtf8`
166+instance MimeRender PlainText Text.Text where
167+ toByteString _ = Text.encodeUtf8
168+
169+-- | `id`
170+instance MimeRender OctetStream ByteString where
171+ toByteString _ = id
172+
173+--------------------------------------------------------------------------
174+-- * MimeUnrender Instances
175+
176+-- | `eitherDecode`
177+instance FromJSON a => MimeUnrender JSON a where
178+ fromByteString _ = eitherDecode
179+
180+-- | `left show . Text.decodeUtf8'`
181+instance MimeUnrender PlainText Text.Text where
182+ fromByteString _ = left show . Text.decodeUtf8'
183+
184+-- | `Right . id`
185+instance MimeUnrender OctetStream ByteString where
186+ fromByteString _ = Right . id