Merge pull request #9 from anchor/content-types

Code changes to support Jkarni/content types.
This commit is contained in:
Julian Arni 2015-03-04 11:10:20 +01:00
commit af8e395664
2 changed files with 26 additions and 19 deletions

View file

@ -1,9 +1,12 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-}
module Servant.JQuery.Internal where
import Control.Applicative
@ -15,6 +18,7 @@ import Data.List
import Data.Monoid
import Data.Proxy
import qualified Data.Text as T
import GHC.Exts (Constraint)
import GHC.TypeLits
import Servant.API
@ -157,7 +161,12 @@ paramToStr qarg notTheEnd =
defReq :: AjaxReq
defReq = AjaxReq defUrl "GET" [] False ""
class HasJQ layout where
type family Elem (a :: *) (ls::[*]) :: Constraint where
Elem a '[] = 'False ~ 'True
Elem a (a ': list) = ()
Elem a (b ': list) = Elem a list
class HasJQ (layout :: *) where
type JQ layout :: *
jqueryFor :: Proxy layout -> AjaxReq -> JQ layout
@ -186,8 +195,8 @@ instance HasJQ Delete where
req & funcName %~ ("delete" <>)
& reqMethod .~ "DELETE"
instance HasJQ (Get a) where
type JQ (Get a) = AjaxReq
instance Elem JSON list => HasJQ (Get list a) where
type JQ (Get list a) = AjaxReq
jqueryFor Proxy req =
req & funcName %~ ("get" <>)
@ -203,15 +212,15 @@ instance (KnownSymbol sym, HasJQ sublayout)
where hname = symbolVal (Proxy :: Proxy sym)
subP = Proxy :: Proxy sublayout
instance HasJQ (Post a) where
type JQ (Post a) = AjaxReq
instance Elem JSON list => HasJQ (Post list a) where
type JQ (Post list a) = AjaxReq
jqueryFor Proxy req =
req & funcName %~ ("post" <>)
& reqMethod .~ "POST"
instance HasJQ (Put a) where
type JQ (Put a) = AjaxReq
instance Elem JSON list => HasJQ (Put list a) where
type JQ (Put list a) = AjaxReq
jqueryFor Proxy req =
req & funcName %~ ("put" <>)
@ -226,7 +235,6 @@ instance (KnownSymbol sym, HasJQ sublayout)
req & reqUrl.queryStr <>~ [QueryArg str Normal]
where str = symbolVal (Proxy :: Proxy sym)
strArg = str ++ "Value"
instance (KnownSymbol sym, HasJQ sublayout)
=> HasJQ (QueryParams sym a :> sublayout) where
@ -255,8 +263,8 @@ instance HasJQ Raw where
req & funcName %~ ((toLower <$> method) <>)
& reqMethod .~ method
instance HasJQ sublayout => HasJQ (ReqBody a :> sublayout) where
type JQ (ReqBody a :> sublayout) = JQ sublayout
instance (Elem JSON list, HasJQ sublayout) => HasJQ (ReqBody list a :> sublayout) where
type JQ (ReqBody list a :> sublayout) = JQ sublayout
jqueryFor Proxy req =
jqueryFor (Proxy :: Proxy sublayout) $

View file

@ -13,28 +13,27 @@ import Language.ECMAScript3.Parser (parseFromString)
import Test.Hspec
import Servant.API
import Servant.API.ContentTypes
import Servant.JQuery
import Servant.JQuerySpec.CustomHeaders
type TestAPI = [sitemap|
POST /simple String -> Bool
GET /has.extension Bool
|]
type TestAPI = "simple" :> ReqBody '[JSON,FormUrlEncoded] String :> Post '[JSON] Bool
:<|> "has.extension" :> Get '[FormUrlEncoded,JSON] Bool
type TopLevelRawAPI = "something" :> Get Int
type TopLevelRawAPI = "something" :> Get '[JSON] Int
:<|> Raw
type HeaderHandlingAPI = "something" :> Header "Foo" String
:> Get Int
:> Get '[JSON] Int
type CustomAuthAPI = "something" :> Authorization "Basic" String
:> Get Int
:> Get '[JSON] Int
type CustomHeaderAPI = "something" :> MyLovelyHorse String
:> Get Int
:> Get '[JSON] Int
type CustomHeaderAPI2 = "something" :> WhatsForDinner String
:> Get Int
:> Get '[JSON] Int
headerHandlingProxy :: Proxy HeaderHandlingAPI
headerHandlingProxy = Proxy