eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

Code changes to support Jkarni/content types.

Browse source 
These are just straight forward changes to compile against servant.
This commit is contained in:
Timo von Holtz 2015-02-19 11:36:31 +11:00
parent f62bb79da1
commit 5578488538
2 changed files with 25 additions and 19 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

28
src/Servant/JQuery/Internal.hs
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) $

16
test/Servant/JQuerySpec.hs
View file

@ -16,25 +16,23 @@ import Servant.API
import Servant.JQuery
import Servant.JQuerySpec.CustomHeaders
type TestAPI = [sitemap|
POST /simple String -> Bool
GET /has.extension Bool
|]
type TestAPI = "simple" :> ReqBody '[JSON] String :> Post '[JSON] Bool
:<|> "has.extension" :> Get '[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