[servant-foreign] Parameterise type classes with a foreign representation type

We allow a user-specified type to represent the foreign type of haskell
types encountered in the API. This lets users map Integer, Date etc. to
representations other than Text, and have those representations
available in the returned list of Req.

For example, we might want to map a type which has an instance of
Generic to both a foreign type name and a class declaration for that
foreign type such that it can encode/decode itself to JSON. The previous
limitation to a single Text output prevented this case.
This commit is contained in:
Steve Purcell 2016-03-14 10:21:36 +13:00
parent 207f05e759
commit 5188e842a9
8 changed files with 155 additions and 169 deletions

View file

@ -65,7 +65,6 @@ test-suite spec
build-depends: base
, hspec >= 2.1.8
, servant-foreign
, text >= 1.2 && < 1.3
default-language: Haskell2010
default-extensions: ConstraintKinds
, DataKinds

View file

@ -10,7 +10,6 @@ module Servant.Foreign
, Url(..)
-- aliases
, Path
, ForeignType(..)
, Arg(..)
, FunctionName(..)
, PathSegment(..)
@ -31,7 +30,6 @@ module Servant.Foreign
, headerArg
-- prisms
, _PathSegment
, _ForeignType
, _HeaderArg
, _ReplaceHeaderArg
, _Static
@ -42,7 +40,6 @@ module Servant.Foreign
-- rest of it
, HasForeign(..)
, HasForeignType(..)
, HasNoForeignType
, GenerateList(..)
, NoTypes
, captureArg

View file

@ -27,15 +27,6 @@ newtype FunctionName = FunctionName { unFunctionName :: [Text] }
makePrisms ''FunctionName
newtype ForeignType f = ForeignType { unForeignType :: f }
deriving instance Show f => Show (ForeignType f)
deriving instance Eq f => Eq (ForeignType f)
deriving instance IsString f => IsString (ForeignType f)
deriving instance Monoid f => Monoid (ForeignType f)
makePrisms ''ForeignType
newtype PathSegment = PathSegment { unPathSegment :: Text }
deriving (Show, Eq, IsString, Monoid)
@ -43,7 +34,7 @@ makePrisms ''PathSegment
data Arg f = Arg
{ _argName :: PathSegment
, _argType :: ForeignType f }
, _argType :: f }
deriving instance Eq f => Eq (Arg f)
deriving instance Show f => Show (Arg f)
@ -130,8 +121,8 @@ data Req f = Req
{ _reqUrl :: Url f
, _reqMethod :: HTTP.Method
, _reqHeaders :: [HeaderArg f]
, _reqBody :: Maybe (ForeignType f)
, _reqReturnType :: ForeignType f
, _reqBody :: Maybe f
, _reqReturnType :: Maybe f
, _reqFuncName :: FunctionName
}
@ -140,8 +131,8 @@ deriving instance Show f => Show (Req f)
makeLenses ''Req
defReq :: Req Text
defReq = Req defUrl "GET" [] Nothing (ForeignType "") (FunctionName [])
defReq :: Req ftype
defReq = Req defUrl "GET" [] Nothing Nothing (FunctionName [])
-- | To be used exclusively as a "negative" return type/constraint
-- by @'Elem`@ type family.
@ -154,158 +145,158 @@ type family Elem (a :: *) (ls::[*]) :: Constraint where
-- | 'HasForeignType' maps Haskell types with types in the target
-- language of your backend. For example, let's say you're
-- implementing a backend to some language __X__:
-- implementing a backend to some language __X__, and you want
-- a Text representation of each input/output type mentioned in the API:
--
-- > -- First you need to create a dummy type to parametrize your
-- > -- instances.
-- > data LangX
-- >
-- > -- Otherwise you define instances for the types you need
-- > instance HasForeignType LangX Int where
-- > typeFor _ _ = "intX"
-- > instance HasForeignType LangX Text Int where
-- > typeFor _ _ _ = "intX"
-- >
-- > -- Or for example in case of lists
-- > instance HasForeignType LangX a => HasForeignType LangX [a] where
-- > typeFor lang _ = "listX of " <> typeFor lang (Proxy :: Proxy a)
-- > instance HasForeignType LangX Text a => HasForeignType LangX Text [a] where
-- > typeFor lang type _ = "listX of " <> typeFor lang ftype (Proxy :: Proxy a)
--
-- Finally to generate list of information about all the endpoints for
-- an API you create a function of a form:
--
-- > getEndpoints :: (HasForeign LangX api, GenerateList (Foreign api))
-- > => Proxy api -> [Req]
-- > getEndpoints api = listFromAPI (Proxy :: Proxy LangX) api
-- > getEndpoints :: (HasForeign LangX Text api, GenerateList Text (Foreign Text api))
-- > => Proxy api -> [Req Text]
-- > getEndpoints api = listFromAPI (Proxy :: Proxy LangX) (Proxy :: Proxy Text) api
--
-- > -- If language __X__ is dynamically typed then you can use
-- > -- a predefined NoTypes parameter
-- > getEndpoints :: (HasForeign NoTypes api, GenerateList (Foreign api))
-- > => Proxy api -> [Req]
-- > getEndpoints api = listFromAPI (Proxy :: Proxy NoTypes) api
-- > -- a predefined NoTypes parameter with the () output type:
--
-- > getEndpoints :: (HasForeign NoTypes () api, GenerateList Text (Foreign () api))
-- > => Proxy api -> [Req ()]
-- > getEndpoints api = listFromAPI (Proxy :: Proxy NoTypes) (Proxy :: Proxy ()) api
-- >
--
class HasForeignType lang a where
typeFor :: Proxy lang -> Proxy a -> ForeignType Text
class HasForeignType lang ftype a where
typeFor :: Proxy lang -> Proxy ftype -> Proxy a -> ftype
data NoTypes
instance HasForeignType NoTypes ftype where
typeFor _ _ = ForeignType empty
instance HasForeignType NoTypes () ftype where
typeFor _ _ _ = ()
type HasNoForeignType = HasForeignType NoTypes
class HasForeign lang ftype (layout :: *) where
type Foreign ftype layout :: *
foreignFor :: Proxy lang -> Proxy ftype -> Proxy layout -> Req ftype -> Foreign ftype layout
class HasForeign lang (layout :: *) where
type Foreign layout :: *
foreignFor :: Proxy lang -> Proxy layout -> Req Text -> Foreign layout
instance (HasForeign lang ftype a, HasForeign lang ftype b)
=> HasForeign lang ftype (a :<|> b) where
type Foreign ftype (a :<|> b) = Foreign ftype a :<|> Foreign ftype b
instance (HasForeign lang a, HasForeign lang b)
=> HasForeign lang (a :<|> b) where
type Foreign (a :<|> b) = Foreign a :<|> Foreign b
foreignFor lang ftype Proxy req =
foreignFor lang ftype (Proxy :: Proxy a) req
:<|> foreignFor lang ftype (Proxy :: Proxy b) req
foreignFor lang Proxy req =
foreignFor lang (Proxy :: Proxy a) req
:<|> foreignFor lang (Proxy :: Proxy b) req
instance (KnownSymbol sym, HasForeignType lang ftype t, HasForeign lang ftype sublayout)
=> HasForeign lang ftype (Capture sym t :> sublayout) where
type Foreign ftype (Capture sym a :> sublayout) = Foreign ftype sublayout
instance (KnownSymbol sym, HasForeignType lang ftype, HasForeign lang sublayout)
=> HasForeign lang (Capture sym ftype :> sublayout) where
type Foreign (Capture sym a :> sublayout) = Foreign sublayout
foreignFor lang Proxy req =
foreignFor lang (Proxy :: Proxy sublayout) $
foreignFor lang Proxy Proxy req =
foreignFor lang Proxy (Proxy :: Proxy sublayout) $
req & reqUrl . path <>~ [Segment (Cap arg)]
& reqFuncName . _FunctionName %~ (++ ["by", str])
where
str = pack . symbolVal $ (Proxy :: Proxy sym)
ftype = typeFor lang (Proxy :: Proxy ftype)
ftype = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy t)
arg = Arg
{ _argName = PathSegment str
, _argType = ftype }
instance (Elem JSON list, HasForeignType lang a, ReflectMethod method)
=> HasForeign lang (Verb method status list a) where
type Foreign (Verb method status list a) = Req Text
instance (Elem JSON list, HasForeignType lang ftype a, ReflectMethod method)
=> HasForeign lang ftype (Verb method status list a) where
type Foreign ftype (Verb method status list a) = Req ftype
foreignFor lang Proxy req =
foreignFor lang Proxy Proxy req =
req & reqFuncName . _FunctionName %~ (methodLC :)
& reqMethod .~ method
& reqReturnType .~ retType
& reqReturnType .~ Just retType
where
retType = typeFor lang (Proxy :: Proxy a)
retType = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy a)
method = reflectMethod (Proxy :: Proxy method)
methodLC = toLower $ decodeUtf8 method
instance (KnownSymbol sym, HasForeignType lang a, HasForeign lang sublayout)
=> HasForeign lang (Header sym a :> sublayout) where
type Foreign (Header sym a :> sublayout) = Foreign sublayout
instance (KnownSymbol sym, HasForeignType lang ftype a, HasForeign lang ftype sublayout)
=> HasForeign lang ftype (Header sym a :> sublayout) where
type Foreign ftype (Header sym a :> sublayout) = Foreign ftype sublayout
foreignFor lang Proxy req =
foreignFor lang subP $ req & reqHeaders <>~ [HeaderArg arg]
foreignFor lang Proxy Proxy req =
foreignFor lang Proxy subP $ req & reqHeaders <>~ [HeaderArg arg]
where
hname = pack . symbolVal $ (Proxy :: Proxy sym)
arg = Arg
{ _argName = PathSegment hname
, _argType = typeFor lang (Proxy :: Proxy a) }
, _argType = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy a) }
subP = Proxy :: Proxy sublayout
instance (KnownSymbol sym, HasForeignType lang a, HasForeign lang sublayout)
=> HasForeign lang (QueryParam sym a :> sublayout) where
type Foreign (QueryParam sym a :> sublayout) = Foreign sublayout
instance (KnownSymbol sym, HasForeignType lang ftype a, HasForeign lang ftype sublayout)
=> HasForeign lang ftype (QueryParam sym a :> sublayout) where
type Foreign ftype (QueryParam sym a :> sublayout) = Foreign ftype sublayout
foreignFor lang Proxy req =
foreignFor lang (Proxy :: Proxy sublayout) $
foreignFor lang Proxy Proxy req =
foreignFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy sublayout) $
req & reqUrl.queryStr <>~ [QueryArg arg Normal]
where
str = pack . symbolVal $ (Proxy :: Proxy sym)
arg = Arg
{ _argName = PathSegment str
, _argType = typeFor lang (Proxy :: Proxy a) }
, _argType = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy a) }
instance
(KnownSymbol sym, HasForeignType lang [a], HasForeign lang sublayout)
=> HasForeign lang (QueryParams sym a :> sublayout) where
type Foreign (QueryParams sym a :> sublayout) = Foreign sublayout
foreignFor lang Proxy req =
foreignFor lang (Proxy :: Proxy sublayout) $
(KnownSymbol sym, HasForeignType lang ftype [a], HasForeign lang ftype sublayout)
=> HasForeign lang ftype (QueryParams sym a :> sublayout) where
type Foreign ftype (QueryParams sym a :> sublayout) = Foreign ftype sublayout
foreignFor lang Proxy Proxy req =
foreignFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy sublayout) $
req & reqUrl.queryStr <>~ [QueryArg arg List]
where
str = pack . symbolVal $ (Proxy :: Proxy sym)
arg = Arg
{ _argName = PathSegment str
, _argType = typeFor lang (Proxy :: Proxy [a]) }
, _argType = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy [a]) }
instance
(KnownSymbol sym, HasForeignType lang Bool, HasForeign lang sublayout)
=> HasForeign lang (QueryFlag sym :> sublayout) where
type Foreign (QueryFlag sym :> sublayout) = Foreign sublayout
(KnownSymbol sym, HasForeignType lang ftype Bool, HasForeign lang ftype sublayout)
=> HasForeign lang ftype (QueryFlag sym :> sublayout) where
type Foreign ftype (QueryFlag sym :> sublayout) = Foreign ftype sublayout
foreignFor lang Proxy req =
foreignFor lang (Proxy :: Proxy sublayout) $
foreignFor lang ftype Proxy req =
foreignFor lang ftype (Proxy :: Proxy sublayout) $
req & reqUrl.queryStr <>~ [QueryArg arg Flag]
where
str = pack . symbolVal $ (Proxy :: Proxy sym)
arg = Arg
{ _argName = PathSegment str
, _argType = typeFor lang (Proxy :: Proxy Bool) }
, _argType = typeFor lang ftype (Proxy :: Proxy Bool) }
instance HasForeign lang Raw where
type Foreign Raw = HTTP.Method -> Req Text
instance HasForeign lang ftype Raw where
type Foreign ftype Raw = HTTP.Method -> Req ftype
foreignFor _ Proxy req method =
foreignFor _ Proxy Proxy req method =
req & reqFuncName . _FunctionName %~ ((toLower $ decodeUtf8 method) :)
& reqMethod .~ method
instance (Elem JSON list, HasForeignType lang a, HasForeign lang sublayout)
=> HasForeign lang (ReqBody list a :> sublayout) where
type Foreign (ReqBody list a :> sublayout) = Foreign sublayout
instance (Elem JSON list, HasForeignType lang ftype a, HasForeign lang ftype sublayout)
=> HasForeign lang ftype (ReqBody list a :> sublayout) where
type Foreign ftype (ReqBody list a :> sublayout) = Foreign ftype sublayout
foreignFor lang Proxy req =
foreignFor lang (Proxy :: Proxy sublayout) $
req & reqBody .~ (Just $ typeFor lang (Proxy :: Proxy a))
foreignFor lang ftype Proxy req =
foreignFor lang ftype (Proxy :: Proxy sublayout) $
req & reqBody .~ (Just $ typeFor lang ftype (Proxy :: Proxy a))
instance (KnownSymbol path, HasForeign lang sublayout)
=> HasForeign lang (path :> sublayout) where
type Foreign (path :> sublayout) = Foreign sublayout
instance (KnownSymbol path, HasForeign lang ftype sublayout)
=> HasForeign lang ftype (path :> sublayout) where
type Foreign ftype (path :> sublayout) = Foreign ftype sublayout
foreignFor lang Proxy req =
foreignFor lang (Proxy :: Proxy sublayout) $
foreignFor lang ftype Proxy req =
foreignFor lang ftype (Proxy :: Proxy sublayout) $
req & reqUrl . path <>~ [Segment (Static (PathSegment str))]
& reqFuncName . _FunctionName %~ (++ [str])
where
@ -313,58 +304,59 @@ instance (KnownSymbol path, HasForeign lang sublayout)
Data.Text.map (\c -> if c == '.' then '_' else c)
. pack . symbolVal $ (Proxy :: Proxy path)
instance HasForeign lang sublayout
=> HasForeign lang (RemoteHost :> sublayout) where
type Foreign (RemoteHost :> sublayout) = Foreign sublayout
instance HasForeign lang ftype sublayout
=> HasForeign lang ftype (RemoteHost :> sublayout) where
type Foreign ftype (RemoteHost :> sublayout) = Foreign ftype sublayout
foreignFor lang Proxy req =
foreignFor lang (Proxy :: Proxy sublayout) req
foreignFor lang ftype Proxy req =
foreignFor lang ftype (Proxy :: Proxy sublayout) req
instance HasForeign lang sublayout
=> HasForeign lang (IsSecure :> sublayout) where
type Foreign (IsSecure :> sublayout) = Foreign sublayout
instance HasForeign lang ftype sublayout
=> HasForeign lang ftype (IsSecure :> sublayout) where
type Foreign ftype (IsSecure :> sublayout) = Foreign ftype sublayout
foreignFor lang Proxy req =
foreignFor lang (Proxy :: Proxy sublayout) req
foreignFor lang ftype Proxy req =
foreignFor lang ftype (Proxy :: Proxy sublayout) req
instance HasForeign lang sublayout => HasForeign lang (Vault :> sublayout) where
type Foreign (Vault :> sublayout) = Foreign sublayout
instance HasForeign lang ftype sublayout => HasForeign lang ftype (Vault :> sublayout) where
type Foreign ftype (Vault :> sublayout) = Foreign ftype sublayout
foreignFor lang Proxy req =
foreignFor lang (Proxy :: Proxy sublayout) req
foreignFor lang ftype Proxy req =
foreignFor lang ftype (Proxy :: Proxy sublayout) req
instance HasForeign lang sublayout =>
HasForeign lang (WithNamedContext name context sublayout) where
instance HasForeign lang ftype sublayout =>
HasForeign lang ftype (WithNamedContext name context sublayout) where
type Foreign (WithNamedContext name context sublayout) = Foreign sublayout
type Foreign ftype (WithNamedContext name context sublayout) = Foreign ftype sublayout
foreignFor lang Proxy = foreignFor lang (Proxy :: Proxy sublayout)
foreignFor lang ftype Proxy = foreignFor lang ftype (Proxy :: Proxy sublayout)
instance HasForeign lang sublayout
=> HasForeign lang (HttpVersion :> sublayout) where
type Foreign (HttpVersion :> sublayout) = Foreign sublayout
instance HasForeign lang ftype sublayout
=> HasForeign lang ftype (HttpVersion :> sublayout) where
type Foreign ftype (HttpVersion :> sublayout) = Foreign ftype sublayout
foreignFor lang Proxy req =
foreignFor lang (Proxy :: Proxy sublayout) req
foreignFor lang ftype Proxy req =
foreignFor lang ftype (Proxy :: Proxy sublayout) req
-- | Utility class used by 'listFromAPI' which computes
-- the data needed to generate a function for each endpoint
-- and hands it all back in a list.
class GenerateList reqs where
generateList :: reqs -> [Req Text]
class GenerateList ftype reqs where
generateList :: reqs -> [Req ftype]
instance GenerateList (Req Text) where
instance GenerateList ftype (Req ftype) where
generateList r = [r]
instance (GenerateList start, GenerateList rest)
=> GenerateList (start :<|> rest) where
instance (GenerateList ftype start, GenerateList ftype rest)
=> GenerateList ftype (start :<|> rest) where
generateList (start :<|> rest) = (generateList start) ++ (generateList rest)
-- | Generate the necessary data for codegen as a list, each 'Req'
-- describing one endpoint from your API type.
listFromAPI
:: (HasForeign lang api, GenerateList (Foreign api))
:: (HasForeign lang ftype api, GenerateList ftype (Foreign ftype api))
=> Proxy lang
-> Proxy ftype
-> Proxy api
-> [Req Text]
listFromAPI lang p = generateList (foreignFor lang p defReq)
-> [Req ftype]
listFromAPI lang ftype p = generateList (foreignFor lang ftype p defReq)

View file

@ -6,7 +6,6 @@ module Servant.ForeignSpec where
import Data.Monoid ((<>))
import Data.Proxy
import Servant.Foreign
import Data.Text (Text(..))
import Test.Hspec
@ -27,20 +26,20 @@ camelCaseSpec = describe "camelCase" $ do
data LangX
instance HasForeignType LangX () where
typeFor _ _ = ForeignType "voidX"
instance HasForeignType LangX String () where
typeFor _ _ _ = "voidX"
instance HasForeignType LangX Int where
typeFor _ _ = "intX"
instance HasForeignType LangX String Int where
typeFor _ _ _ = "intX"
instance HasForeignType LangX Bool where
typeFor _ _ = "boolX"
instance HasForeignType LangX String Bool where
typeFor _ _ _ = "boolX"
instance OVERLAPPING_ HasForeignType LangX String where
typeFor _ _ = "stringX"
instance OVERLAPPING_ HasForeignType LangX String String where
typeFor _ _ _ = "stringX"
instance OVERLAPPABLE_ HasForeignType LangX a => HasForeignType LangX [a] where
typeFor lang _ = "listX of " <> typeFor lang (Proxy :: Proxy a)
instance OVERLAPPABLE_ HasForeignType LangX String a => HasForeignType LangX String [a] where
typeFor lang ftype _ = "listX of " <> typeFor lang ftype (Proxy :: Proxy a)
type TestApi
= "test" :> Header "header" [String] :> QueryFlag "flag" :> Get '[JSON] Int
@ -48,8 +47,8 @@ type TestApi
:<|> "test" :> QueryParams "params" Int :> ReqBody '[JSON] String :> Put '[JSON] ()
:<|> "test" :> Capture "id" Int :> Delete '[JSON] ()
testApi :: [Req Text]
testApi = listFromAPI (Proxy :: Proxy LangX) (Proxy :: Proxy TestApi)
testApi :: [Req String]
testApi = listFromAPI (Proxy :: Proxy LangX) (Proxy :: Proxy String) (Proxy :: Proxy TestApi)
listFromAPISpec :: Spec
listFromAPISpec = describe "listFromAPI" $ do
@ -66,7 +65,7 @@ listFromAPISpec = describe "listFromAPI" $ do
, _reqMethod = "GET"
, _reqHeaders = [HeaderArg $ Arg "header" "listX of stringX"]
, _reqBody = Nothing
, _reqReturnType = "intX"
, _reqReturnType = Just "intX"
, _reqFuncName = FunctionName ["get", "test"]
}
@ -78,7 +77,7 @@ listFromAPISpec = describe "listFromAPI" $ do
, _reqMethod = "POST"
, _reqHeaders = []
, _reqBody = Just "listX of stringX"
, _reqReturnType = "voidX"
, _reqReturnType = Just "voidX"
, _reqFuncName = FunctionName ["post", "test"]
}
@ -91,7 +90,7 @@ listFromAPISpec = describe "listFromAPI" $ do
, _reqMethod = "PUT"
, _reqHeaders = []
, _reqBody = Just "stringX"
, _reqReturnType = "voidX"
, _reqReturnType = Just "voidX"
, _reqFuncName = FunctionName ["put", "test"]
}
@ -104,6 +103,6 @@ listFromAPISpec = describe "listFromAPI" $ do
, _reqMethod = "DELETE"
, _reqHeaders = []
, _reqBody = Nothing
, _reqReturnType = "voidX"
, _reqReturnType = Just "voidX"
, _reqFuncName = FunctionName ["delete", "test", "by", "id"]
}

View file

@ -128,22 +128,22 @@ import Servant.Foreign (GenerateList(..), listFromAPI, NoTypes)
-- | Generate the data necessary to generate javascript code
-- for all the endpoints of an API, as ':<|>'-separated values
-- of type 'AjaxReq'.
javascript :: HasForeign NoTypes layout => Proxy layout -> Foreign layout
javascript p = foreignFor (Proxy :: Proxy NoTypes) p defReq
javascript :: HasForeign NoTypes () layout => Proxy layout -> Foreign () layout
javascript p = foreignFor (Proxy :: Proxy NoTypes) (Proxy :: Proxy ()) p defReq
-- | Directly generate all the javascript functions for your API
-- from a 'Proxy' for your API type. You can then write it to
-- a file or integrate it in a page, for example.
jsForAPI :: (HasForeign NoTypes api, GenerateList (Foreign api))
jsForAPI :: (HasForeign NoTypes () api, GenerateList () (Foreign () api))
=> Proxy api -- ^ proxy for your API type
-> JavaScriptGenerator -- ^ js code generator to use (angular, vanilla js, jquery, others)
-> Text -- ^ a text that you can embed in your pages or write to a file
jsForAPI p gen = gen (listFromAPI (Proxy :: Proxy NoTypes) p)
jsForAPI p gen = gen (listFromAPI (Proxy :: Proxy NoTypes) (Proxy :: Proxy ()) p)
-- | Directly generate all the javascript functions for your API
-- from a 'Proxy' for your API type using the given generator
-- and write the resulting code to a file at the given path.
writeJSForAPI :: (HasForeign NoTypes api, GenerateList (Foreign api))
writeJSForAPI :: (HasForeign NoTypes () api, GenerateList () (Foreign () api))
=> Proxy api -- ^ proxy for your API type
-> JavaScriptGenerator -- ^ js code generator to use (angular, vanilla js, jquery, others)
-> FilePath -- ^ path to the file you want to write the resulting javascript code into

View file

@ -21,7 +21,6 @@ module Servant.JS.Internal
, reqHeaders
, HasForeign(..)
, HasForeignType(..)
, HasNoForeignType
, GenerateList(..)
, NoTypes
, HeaderArg
@ -33,7 +32,6 @@ module Servant.JS.Internal
, SegmentType(..)
, Url(..)
, Path
, ForeignType(..)
, Arg(..)
, FunctionName(..)
, PathSegment(..)
@ -57,12 +55,12 @@ import qualified Data.Text as T
import Data.Text (Text)
import Servant.Foreign
type AjaxReq = Req Text
type AjaxReq = Req ()
-- A 'JavascriptGenerator' just takes the data found in the API type
-- for each endpoint and generates Javascript code in a Text. Several
-- generators are available in this package.
type JavaScriptGenerator = [Req Text] -> Text
type JavaScriptGenerator = [Req ()] -> Text
-- | This structure is used by specific implementations to let you
-- customize the output

View file

@ -106,7 +106,7 @@ a `shouldNotContain` b = shouldNotSatisfy a (T.isInfixOf b)
axiosSpec :: Spec
axiosSpec = describe specLabel $ do
let reqList = listFromAPI (Proxy :: Proxy NoTypes) (Proxy :: Proxy TestAPI)
let reqList = listFromAPI (Proxy :: Proxy NoTypes) (Proxy :: Proxy ()) (Proxy :: Proxy TestAPI)
it "should add withCredentials when needed" $ do
let jsText = genJS withCredOpts $ reqList
output jsText
@ -130,7 +130,7 @@ axiosSpec = describe specLabel $ do
angularSpec :: TestNames -> Spec
angularSpec test = describe specLabel $ do
let reqList = listFromAPI (Proxy :: Proxy NoTypes) (Proxy :: Proxy TestAPI)
let reqList = listFromAPI (Proxy :: Proxy NoTypes) (Proxy :: Proxy ()) (Proxy :: Proxy TestAPI)
it "should implement a service globally" $ do
let jsText = genJS reqList
output jsText

View file

@ -1,4 +1,5 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE PolyKinds #-}
@ -22,13 +23,13 @@ import Servant.JS.Internal
-- using -- Basic, Digest, whatever.
data Authorization (sym :: Symbol) a
instance (KnownSymbol sym, HasForeign lang sublayout)
=> HasForeign lang (Authorization sym a :> sublayout) where
type Foreign (Authorization sym a :> sublayout) = Foreign sublayout
instance (KnownSymbol sym, HasForeign lang () sublayout)
=> HasForeign lang () (Authorization sym a :> sublayout) where
type Foreign () (Authorization sym a :> sublayout) = Foreign () sublayout
foreignFor lang Proxy req = foreignFor lang (Proxy :: Proxy sublayout) $
foreignFor lang ftype Proxy req = foreignFor lang ftype (Proxy :: Proxy sublayout) $
req & reqHeaders <>~
[ ReplaceHeaderArg (Arg "Authorization" "")
[ ReplaceHeaderArg (Arg "Authorization" ())
$ tokenType (pack . symbolVal $ (Proxy :: Proxy sym)) ]
where
tokenType t = t <> " {Authorization}"
@ -36,23 +37,23 @@ instance (KnownSymbol sym, HasForeign lang sublayout)
-- | This is a combinator that fetches an X-MyLovelyHorse header.
data MyLovelyHorse a
instance (HasForeign lang sublayout)
=> HasForeign lang (MyLovelyHorse a :> sublayout) where
type Foreign (MyLovelyHorse a :> sublayout) = Foreign sublayout
instance (HasForeign lang () sublayout)
=> HasForeign lang () (MyLovelyHorse a :> sublayout) where
type Foreign () (MyLovelyHorse a :> sublayout) = Foreign () sublayout
foreignFor lang Proxy req = foreignFor lang (Proxy :: Proxy sublayout) $
req & reqHeaders <>~ [ ReplaceHeaderArg (Arg "X-MyLovelyHorse" "") tpl ]
foreignFor lang ftype Proxy req = foreignFor lang ftype (Proxy :: Proxy sublayout) $
req & reqHeaders <>~ [ ReplaceHeaderArg (Arg "X-MyLovelyHorse" ()) tpl ]
where
tpl = "I am good friends with {X-MyLovelyHorse}"
-- | This is a combinator that fetches an X-WhatsForDinner header.
data WhatsForDinner a
instance (HasForeign lang sublayout)
=> HasForeign lang (WhatsForDinner a :> sublayout) where
type Foreign (WhatsForDinner a :> sublayout) = Foreign sublayout
instance (HasForeign lang () sublayout)
=> HasForeign lang () (WhatsForDinner a :> sublayout) where
type Foreign () (WhatsForDinner a :> sublayout) = Foreign () sublayout
foreignFor lang Proxy req = foreignFor lang (Proxy :: Proxy sublayout) $
req & reqHeaders <>~ [ ReplaceHeaderArg (Arg "X-WhatsForDinner" "") tpl ]
foreignFor lang ftype Proxy req = foreignFor lang ftype (Proxy :: Proxy sublayout) $
req & reqHeaders <>~ [ ReplaceHeaderArg (Arg "X-WhatsForDinner" ()) tpl ]
where
tpl = "I would like {X-WhatsForDinner} with a cherry on top."