envelope 0.1.0.0 → 0.2.0.0

raw patch · 2 files changed

+84/−14 lines, 2 filesdep +http-api-dataPVP ok

version bump matches the API change (PVP)

Dependencies added: http-api-data

API changes (from Hackage documentation)

Files

• envelope.cabal +2/−1
• src/Web/Envelope.hs +82/−13

@@ -1,5 +1,5 @@ name:                envelope-version:             0.1.0.0+version:             0.2.0.0 synopsis:            Defines generic 'Envelope' type to wrap reponses from a JSON API. description:         Please see README.md homepage:            https://github.com/cdepillabout/envelope#readme@@ -18,6 +18,7 @@   exposed-modules:     Web.Envelope   build-depends:       base >= 4.8 && < 5                      , aeson >= 0.11+                     , http-api-data >= 0.3                      , mtl >= 2.2                      , text >= 1.2   default-language:    Haskell2010

@@ -1,6 +1,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE OverloadedStrings #-} @@ -59,15 +60,23 @@ import Control.Monad.Except (MonadError, throwError) import Control.Applicative ((<|>)) import Data.Aeson-    ( (.=), (.:), FromJSON(..), ToJSON(..), Value(..), object )+       ((.=), (.:), FromJSON(..), ToJSON(..), Value(..), object) import Data.Aeson.TH (deriveJSON) import Data.Aeson.Types (Parser, typeMismatch) import Data.Data (Data)+import Data.Maybe (maybeToList) import Data.Text (Text) import Data.Typeable (Typeable) import GHC.Generics (Generic)+import Web.FormUrlEncoded+       (FromForm(fromForm), ToForm(toForm), fromEntriesByKey, lookupMaybe,+        lookupUnique, parseUnique)+import Web.HttpApiData+       (FromHttpApiData, ToHttpApiData(toQueryParam))+import Web.Internal.FormUrlEncoded (Form) --- | Main type to be used.  Wrapper around responses from an API, mainly used with a JSON API.+-- | Main type to be used.  Wrapper around responses from an API, mainly used+-- with a JSON API. -- -- Type synonym around 'Envelope''. type Envelope e a = Envelope' (Err e) (Success a)@@ -95,15 +104,35 @@               <|> EnvelopeErr     <$> parseJSON v               <|> typeMismatch "Envelope'" v --- | Newtype wrapper to be able to provide 'ToJSON' and 'FromJSON' instances.--- Used with 'Envelope'.+-- | Uses the underlying 'ToForm' instance for both the 'EnvelopeErr' case and+-- the 'EnvelopeSuccess' case.+instance (ToForm a, ToForm e) =>+         ToForm (Envelope' e a) where+  toForm :: Envelope' e a -> Form+  toForm (EnvelopeErr err) = toForm err+  toForm (EnvelopeSuccess succ) = toForm succ++-- | Looks for the key @\"error\"@ in the 'Form'.  If it is found, assume this+-- form is an @'Err e'@.  If it is not found, assume this 'Form' is an @a@.+--+-- __WARNING__: If the @a@ is encoded with a key @\"error\"@, this 'Form' will+-- be decoded as a 'EnvelopeErr' instead of a 'EnvelopeSuccess'.  This is+-- probably not what you want.+instance (FromForm a, FromHttpApiData e) =>+         FromForm (Envelope' (Err e) a) where+  fromForm :: Form -> Either Text (Envelope' (Err e) a)+  fromForm form =+    case lookupUnique "error" form of+      -- Key "error" doesn't exist, so assume this is an @a@.+      Left _ -> EnvelopeSuccess <$> fromForm form+      -- Key "error exists, so assume this is an @'Err' e@.+      Right _ -> EnvelopeErr <$> fromForm form++-- | Newtype wrapper to be able to provide specific instances. Used with+-- 'Envelope'. newtype Success a = Success a     deriving (Data, Eq, Generic, Show, Typeable) -instance (ToJSON a) => ToJSON (Success a) where-    toJSON :: Success a -> Value-    toJSON (Success a) = object ["data" .= a]- -- | For @'Success' a@, wrap the @a@ in an object with a @\"data\"@ field. -- -- The resulting JSON object will look like this:@@ -111,21 +140,35 @@ -- @ --  { \"data\": ... } -- @+instance (ToJSON a) => ToJSON (Success a) where+    toJSON :: Success a -> Value+    toJSON (Success a) = object ["data" .= a]++-- | Parse the JSON object produced by the 'ToJSON' instance. instance (FromJSON e) => FromJSON (Success e) where     parseJSON :: Value -> Parser (Success e)     parseJSON (Object v) = Success <$> v .: "data"     parseJSON invalid    = typeMismatch "Success" invalid --- | Newtype wrapper to be able to provide 'ToJSON' and 'FromJSON' instances.+-- | Use the 'ToForm' instance of the underlying datatype.+instance (ToForm a) =>+         ToForm (Success a) where+  toForm :: Success a -> Form+  toForm (Success a) = toForm a++-- | Use the 'FromForm' instance of the underlying datatype.+instance (FromForm a) =>+         FromForm (Success a) where+  fromForm :: Form -> Either Text (Success a)+  fromForm form = Success <$> fromForm form++-- | Wrapper to add an extra field with info about the error.  Used with+-- 'Envelope'. data Err e = Err { errErr   :: e          -- ^ Actual error information we want to send.                  , errExtra :: Maybe Text -- ^ Additional error information in plain text.                  }     deriving (Data, Eq, Generic, Show, Typeable) -instance (ToJSON e) => ToJSON (Err e) where-    toJSON :: Err e -> Value-    toJSON (Err e extra) = object ["error" .= e, "extra" .= extra]- -- | For @'Err' e@, wrap the @e@ in an object with @\"extra\"@ and @\"error\"@ fields. -- -- The resulting JSON object will look like this:@@ -133,11 +176,37 @@ -- @ --  { \"extra\": ..., \"error\": .... } -- @+instance (ToJSON e) => ToJSON (Err e) where+    toJSON :: Err e -> Value+    toJSON (Err e extra) = object ["error" .= e, "extra" .= extra]++-- | Parse the JSON object produced by the 'ToJSON' instance. instance (FromJSON e) => FromJSON (Err e) where     parseJSON :: Value -> Parser (Err e)     parseJSON (Object v) = Err <$> v .: "error"                                <*> v .: "extra"     parseJSON invalid    = typeMismatch "Err" invalid++-- | Just use the 'ToForm' instance of the underlying datatype.+--+-- The resulting Form object will look like this:+--+-- @+--  [(\"extra\", ...), (\"error\", ....)]+-- @+instance (ToHttpApiData e) =>+         ToForm (Err e) where+  toForm :: Err e -> Form+  toForm (Err err maybeExtra) =+    fromEntriesByKey+      [("error" :: Text, [toQueryParam err]), ("extra", maybeToList maybeExtra)]++-- | Parse a form produced by the 'ToForm' instance.  Use 'FromHttpApiData's+-- 'Web.HttpApiData.parseQueryParam' to parse the @error@ parameter.+instance (FromHttpApiData e) =>+         FromForm (Err e) where+  fromForm :: Form -> Either Text (Err e)+  fromForm form = Err <$> parseUnique "error" form <*> lookupMaybe "extra" form  -- | Wrap an @a@ in a success 'Envelope'. --