rest-types 1.11.1.1 → 1.12

raw patch · 4 files changed

+77/−1 lines, 4 files

Files

CHANGELOG.md +6/−0
rest-types.cabal +2/−1
src/Rest/Types/Container/Resource.hs +2/−0
src/Rest/Types/Method.hs +67/−0

CHANGELOG.md view

@@ -1,5 +1,11 @@ # Changelog +## 1.12++* Add `method` field to `Resource`, allowing you to use different+  methods than GET in a multi-action.+* Add `Method` data type.+ #### 1.11.1.1  * Return a 405 for unsupported methods.

rest-types.cabal view

@@ -1,5 +1,5 @@ name:                rest-types-version:             1.11.1.1+version:             1.12 description:         Silk Rest Framework Types synopsis:            Silk Rest Framework Types maintainer:          code@silk.co@@ -25,6 +25,7 @@     Rest.Types.Container.Resource     Rest.Types.Error     Rest.Types.Info+    Rest.Types.Method     Rest.Types.Range     Rest.Types.ShowUrl   build-depends:

src/Rest/Types/Container/Resource.hs view

@@ -23,6 +23,7 @@ import Generics.Regular (PF, deriveAll) import Generics.Regular.XmlPickler (gxpickle) import Rest.StringMap.HashMap.Strict (StringHashMap)+import Rest.Types.Method import Text.XML.HXT.Arrow.Pickle import qualified Data.JSON.Schema.Combinators as Json @@ -41,6 +42,7 @@  data Resource = Resource   { uri        :: String+  , method     :: Method   , headers    :: KeyValues   , parameters :: KeyValues   , input      :: String

+ src/Rest/Types/Method.hs view

@@ -0,0 +1,67 @@+{-# LANGUAGE OverloadedStrings #-}+module Rest.Types.Method (Method (..)) where++import Control.Applicative+import Data.Aeson (ToJSON (..), FromJSON (..))+import Data.Aeson.Types (typeMismatch)+import Data.Char (toLower)+import Data.JSON.Schema (JSONSchema (..))+import Text.XML.HXT.Arrow.Pickle+import Text.XML.HXT.Arrow.Pickle.Schema+import Text.XML.HXT.Arrow.Pickle.Xml++import qualified Data.Aeson       as Json+import qualified Data.JSON.Schema as Schema+import qualified Data.Text        as Text++data Method = GET | PUT | POST | DELETE+  deriving (Show, Eq, Bounded, Enum)++instance ToJSON     Method where+  toJSON = toJSON . methodToString++instance FromJSON   Method where+  parseJSON (Json.String s) = case s of+    "GET"    -> return GET+    "PUT"    -> return PUT+    "POST"   -> return POST+    "DELETE" -> return DELETE+    m -> fail $ "Unknown string when parsing method: " ++ Text.unpack m+  parseJSON j = typeMismatch "String" j++instance JSONSchema Method where+  schema _ = Schema.Choice [ Schema.Constant (Json.String "GET")+                           , Schema.Constant (Json.String "PUT")+                           , Schema.Constant (Json.String "POST")+                           , Schema.Constant (Json.String "DELETE")+                           ]++instance XmlPickler Method where+  xpickle = PU+    (\x -> appPickle (xpElem (methodToStringLC x) (xpickle :: PU ())) ())+    (choices (map mkUnpickler enumAll))+    (scAlts (map (\m -> scElem (methodToStringLC m) scEmpty) enumAll))++mkUnpickler :: Method -> Unpickler Method+mkUnpickler m = appUnPickle (xpWrap (const m, const ())+                              (xpElem (methodToStringLC m)+                                (xpickle :: PU ()))+                            )++choice :: Unpickler a -> Unpickler a -> Unpickler a+choice x y = mchoice x pure y++choices :: [Unpickler a] -> Unpickler a+choices = foldr1 choice++enumAll :: (Bounded a, Enum a) => [a]+enumAll = [minBound .. maxBound]++methodToString :: Method -> String+methodToString GET    = "GET"+methodToString PUT    = "PUT"+methodToString POST   = "POST"+methodToString DELETE = "DELETE"++methodToStringLC :: Method -> String+methodToStringLC = map toLower . methodToString