Merge pull request #16 from nsaunders/reqbody

Add ReqBody

Author: nsaunders

src/Type/Trout.purs

@@ -12,6 +12,7 @@ module Type.Trout
        , Named
        , QueryParam
        , QueryParams
+       , ReqBody
        , type (:>)
        , type (:/)
        , type (:<|>)
@@ -76,6 +77,11 @@ data QueryParam (k :: Symbol) t
 -- | type of the value. `k` is the name of the key as a `Symbol`.
 data QueryParams (k :: Symbol) t
 
+-- | Captures the request body. The `r` parameter is the type represented by
+-- | the request body (usually some type specific to the application domain),
+-- | and `cts` represents the content types supported.
+data ReqBody r cts
+
 infixr 9 type Sub as :>
 infixr 9 type LitSub as :/
 infixr 8 type Named as :=

src/Type/Trout/ContentType.purs

@@ -1,6 +1,7 @@
 module Type.Trout.ContentType where
 
 import Prelude
+import Data.Either (Either)
 import Data.List.NonEmpty (NonEmptyList)
 import Data.MediaType (MediaType)
 import Data.Tuple (Tuple(..))
@@ -16,6 +17,9 @@ class HasMediaType ct where
 class MimeRender a ct b | a -> b, ct -> b  where
   mimeRender :: Proxy ct -> a -> b
 
+class MimeParse b ct a | b -> a, ct -> b where
+  mimeParse :: Proxy ct -> b -> Either String a
+
 -- | Renders a value of type `a`, as appropriate for each content type in `cts`,
 -- | as a non-empty list of values of type `b`, corresponding to the content
 -- | types. Content types can be a single type, e.g. `HTML`, or multiple types

src/Type/Trout/ContentType/JSON.purs

@@ -1,11 +1,19 @@
 module Type.Trout.ContentType.JSON where
 
 import Prelude
-import Data.Argonaut (class EncodeJson, encodeJson)
+import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson)
 import Data.Argonaut.Core (stringify)
+import Data.Argonaut.Parser (jsonParser)
 import Data.MediaType.Common (applicationJSON)
 import Data.Tuple (Tuple(..))
-import Type.Trout.ContentType (class AllMimeRender, class HasMediaType, class MimeRender, getMediaType, mimeRender)
+import Type.Trout.ContentType
+  ( class AllMimeRender
+  , class HasMediaType
+  , class MimeParse
+  , class MimeRender
+  , getMediaType
+  , mimeRender
+  )
 
 -- | A content type, corresponding to the `application/json` media type.
 data JSON
@@ -16,5 +24,8 @@ instance hasMediaTypeJson :: HasMediaType JSON where
 instance mimeRenderJson :: EncodeJson a => MimeRender a JSON String where
   mimeRender _ = stringify <<< encodeJson
 
+instance mimeParseJson :: DecodeJson a => MimeParse String JSON a where
+  mimeParse _ = jsonParser >=> decodeJson
+
 instance allMimeRenderJson :: EncodeJson a => AllMimeRender a JSON String where
   allMimeRender p x = pure (Tuple (getMediaType p) (mimeRender p x))