[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:
parent
207f05e759
commit
5188e842a9
8 changed files with 155 additions and 169 deletions
|
@ -65,7 +65,6 @@ test-suite spec
|
||||||
build-depends: base
|
build-depends: base
|
||||||
, hspec >= 2.1.8
|
, hspec >= 2.1.8
|
||||||
, servant-foreign
|
, servant-foreign
|
||||||
, text >= 1.2 && < 1.3
|
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
default-extensions: ConstraintKinds
|
default-extensions: ConstraintKinds
|
||||||
, DataKinds
|
, DataKinds
|
||||||
|
|
|
@ -10,7 +10,6 @@ module Servant.Foreign
|
||||||
, Url(..)
|
, Url(..)
|
||||||
-- aliases
|
-- aliases
|
||||||
, Path
|
, Path
|
||||||
, ForeignType(..)
|
|
||||||
, Arg(..)
|
, Arg(..)
|
||||||
, FunctionName(..)
|
, FunctionName(..)
|
||||||
, PathSegment(..)
|
, PathSegment(..)
|
||||||
|
@ -31,7 +30,6 @@ module Servant.Foreign
|
||||||
, headerArg
|
, headerArg
|
||||||
-- prisms
|
-- prisms
|
||||||
, _PathSegment
|
, _PathSegment
|
||||||
, _ForeignType
|
|
||||||
, _HeaderArg
|
, _HeaderArg
|
||||||
, _ReplaceHeaderArg
|
, _ReplaceHeaderArg
|
||||||
, _Static
|
, _Static
|
||||||
|
@ -42,7 +40,6 @@ module Servant.Foreign
|
||||||
-- rest of it
|
-- rest of it
|
||||||
, HasForeign(..)
|
, HasForeign(..)
|
||||||
, HasForeignType(..)
|
, HasForeignType(..)
|
||||||
, HasNoForeignType
|
|
||||||
, GenerateList(..)
|
, GenerateList(..)
|
||||||
, NoTypes
|
, NoTypes
|
||||||
, captureArg
|
, captureArg
|
||||||
|
|
|
@ -27,15 +27,6 @@ newtype FunctionName = FunctionName { unFunctionName :: [Text] }
|
||||||
|
|
||||||
makePrisms ''FunctionName
|
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 }
|
newtype PathSegment = PathSegment { unPathSegment :: Text }
|
||||||
deriving (Show, Eq, IsString, Monoid)
|
deriving (Show, Eq, IsString, Monoid)
|
||||||
|
|
||||||
|
@ -43,7 +34,7 @@ makePrisms ''PathSegment
|
||||||
|
|
||||||
data Arg f = Arg
|
data Arg f = Arg
|
||||||
{ _argName :: PathSegment
|
{ _argName :: PathSegment
|
||||||
, _argType :: ForeignType f }
|
, _argType :: f }
|
||||||
|
|
||||||
deriving instance Eq f => Eq (Arg f)
|
deriving instance Eq f => Eq (Arg f)
|
||||||
deriving instance Show f => Show (Arg f)
|
deriving instance Show f => Show (Arg f)
|
||||||
|
@ -130,8 +121,8 @@ data Req f = Req
|
||||||
{ _reqUrl :: Url f
|
{ _reqUrl :: Url f
|
||||||
, _reqMethod :: HTTP.Method
|
, _reqMethod :: HTTP.Method
|
||||||
, _reqHeaders :: [HeaderArg f]
|
, _reqHeaders :: [HeaderArg f]
|
||||||
, _reqBody :: Maybe (ForeignType f)
|
, _reqBody :: Maybe f
|
||||||
, _reqReturnType :: ForeignType f
|
, _reqReturnType :: Maybe f
|
||||||
, _reqFuncName :: FunctionName
|
, _reqFuncName :: FunctionName
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -140,8 +131,8 @@ deriving instance Show f => Show (Req f)
|
||||||
|
|
||||||
makeLenses ''Req
|
makeLenses ''Req
|
||||||
|
|
||||||
defReq :: Req Text
|
defReq :: Req ftype
|
||||||
defReq = Req defUrl "GET" [] Nothing (ForeignType "") (FunctionName [])
|
defReq = Req defUrl "GET" [] Nothing Nothing (FunctionName [])
|
||||||
|
|
||||||
-- | To be used exclusively as a "negative" return type/constraint
|
-- | To be used exclusively as a "negative" return type/constraint
|
||||||
-- by @'Elem`@ type family.
|
-- by @'Elem`@ type family.
|
||||||
|
@ -154,158 +145,158 @@ type family Elem (a :: *) (ls::[*]) :: Constraint where
|
||||||
|
|
||||||
-- | 'HasForeignType' maps Haskell types with types in the target
|
-- | 'HasForeignType' maps Haskell types with types in the target
|
||||||
-- language of your backend. For example, let's say you're
|
-- 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
|
-- > -- First you need to create a dummy type to parametrize your
|
||||||
-- > -- instances.
|
-- > -- instances.
|
||||||
-- > data LangX
|
-- > data LangX
|
||||||
-- >
|
-- >
|
||||||
-- > -- Otherwise you define instances for the types you need
|
-- > -- Otherwise you define instances for the types you need
|
||||||
-- > instance HasForeignType LangX Int where
|
-- > instance HasForeignType LangX Text Int where
|
||||||
-- > typeFor _ _ = "intX"
|
-- > typeFor _ _ _ = "intX"
|
||||||
-- >
|
-- >
|
||||||
-- > -- Or for example in case of lists
|
-- > -- Or for example in case of lists
|
||||||
-- > instance HasForeignType LangX a => HasForeignType LangX [a] where
|
-- > instance HasForeignType LangX Text a => HasForeignType LangX Text [a] where
|
||||||
-- > typeFor lang _ = "listX of " <> typeFor lang (Proxy :: Proxy a)
|
-- > typeFor lang type _ = "listX of " <> typeFor lang ftype (Proxy :: Proxy a)
|
||||||
--
|
--
|
||||||
-- Finally to generate list of information about all the endpoints for
|
-- Finally to generate list of information about all the endpoints for
|
||||||
-- an API you create a function of a form:
|
-- an API you create a function of a form:
|
||||||
--
|
--
|
||||||
-- > getEndpoints :: (HasForeign LangX api, GenerateList (Foreign api))
|
-- > getEndpoints :: (HasForeign LangX Text api, GenerateList Text (Foreign Text api))
|
||||||
-- > => Proxy api -> [Req]
|
-- > => Proxy api -> [Req Text]
|
||||||
-- > getEndpoints api = listFromAPI (Proxy :: Proxy LangX) api
|
-- > getEndpoints api = listFromAPI (Proxy :: Proxy LangX) (Proxy :: Proxy Text) api
|
||||||
--
|
--
|
||||||
-- > -- If language __X__ is dynamically typed then you can use
|
-- > -- If language __X__ is dynamically typed then you can use
|
||||||
-- > -- a predefined NoTypes parameter
|
-- > -- a predefined NoTypes parameter with the () output type:
|
||||||
-- > getEndpoints :: (HasForeign NoTypes api, GenerateList (Foreign api))
|
--
|
||||||
-- > => Proxy api -> [Req]
|
-- > getEndpoints :: (HasForeign NoTypes () api, GenerateList Text (Foreign () api))
|
||||||
-- > getEndpoints api = listFromAPI (Proxy :: Proxy NoTypes) api
|
-- > => Proxy api -> [Req ()]
|
||||||
|
-- > getEndpoints api = listFromAPI (Proxy :: Proxy NoTypes) (Proxy :: Proxy ()) api
|
||||||
-- >
|
-- >
|
||||||
--
|
--
|
||||||
class HasForeignType lang a where
|
class HasForeignType lang ftype a where
|
||||||
typeFor :: Proxy lang -> Proxy a -> ForeignType Text
|
typeFor :: Proxy lang -> Proxy ftype -> Proxy a -> ftype
|
||||||
|
|
||||||
data NoTypes
|
data NoTypes
|
||||||
|
|
||||||
instance HasForeignType NoTypes ftype where
|
instance HasForeignType NoTypes () ftype where
|
||||||
typeFor _ _ = ForeignType empty
|
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
|
instance (HasForeign lang ftype a, HasForeign lang ftype b)
|
||||||
type Foreign layout :: *
|
=> HasForeign lang ftype (a :<|> b) where
|
||||||
foreignFor :: Proxy lang -> Proxy layout -> Req Text -> Foreign layout
|
type Foreign ftype (a :<|> b) = Foreign ftype a :<|> Foreign ftype b
|
||||||
|
|
||||||
instance (HasForeign lang a, HasForeign lang b)
|
foreignFor lang ftype Proxy req =
|
||||||
=> HasForeign lang (a :<|> b) where
|
foreignFor lang ftype (Proxy :: Proxy a) req
|
||||||
type Foreign (a :<|> b) = Foreign a :<|> Foreign b
|
:<|> foreignFor lang ftype (Proxy :: Proxy b) req
|
||||||
|
|
||||||
foreignFor lang Proxy req =
|
instance (KnownSymbol sym, HasForeignType lang ftype t, HasForeign lang ftype sublayout)
|
||||||
foreignFor lang (Proxy :: Proxy a) req
|
=> HasForeign lang ftype (Capture sym t :> sublayout) where
|
||||||
:<|> foreignFor lang (Proxy :: Proxy b) req
|
type Foreign ftype (Capture sym a :> sublayout) = Foreign ftype sublayout
|
||||||
|
|
||||||
instance (KnownSymbol sym, HasForeignType lang ftype, HasForeign lang sublayout)
|
foreignFor lang Proxy Proxy req =
|
||||||
=> HasForeign lang (Capture sym ftype :> sublayout) where
|
foreignFor lang Proxy (Proxy :: Proxy sublayout) $
|
||||||
type Foreign (Capture sym a :> sublayout) = Foreign sublayout
|
|
||||||
|
|
||||||
foreignFor lang Proxy req =
|
|
||||||
foreignFor lang (Proxy :: Proxy sublayout) $
|
|
||||||
req & reqUrl . path <>~ [Segment (Cap arg)]
|
req & reqUrl . path <>~ [Segment (Cap arg)]
|
||||||
& reqFuncName . _FunctionName %~ (++ ["by", str])
|
& reqFuncName . _FunctionName %~ (++ ["by", str])
|
||||||
where
|
where
|
||||||
str = pack . symbolVal $ (Proxy :: Proxy sym)
|
str = pack . symbolVal $ (Proxy :: Proxy sym)
|
||||||
ftype = typeFor lang (Proxy :: Proxy ftype)
|
ftype = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy t)
|
||||||
arg = Arg
|
arg = Arg
|
||||||
{ _argName = PathSegment str
|
{ _argName = PathSegment str
|
||||||
, _argType = ftype }
|
, _argType = ftype }
|
||||||
|
|
||||||
instance (Elem JSON list, HasForeignType lang a, ReflectMethod method)
|
instance (Elem JSON list, HasForeignType lang ftype a, ReflectMethod method)
|
||||||
=> HasForeign lang (Verb method status list a) where
|
=> HasForeign lang ftype (Verb method status list a) where
|
||||||
type Foreign (Verb method status list a) = Req Text
|
type Foreign ftype (Verb method status list a) = Req ftype
|
||||||
|
|
||||||
foreignFor lang Proxy req =
|
foreignFor lang Proxy Proxy req =
|
||||||
req & reqFuncName . _FunctionName %~ (methodLC :)
|
req & reqFuncName . _FunctionName %~ (methodLC :)
|
||||||
& reqMethod .~ method
|
& reqMethod .~ method
|
||||||
& reqReturnType .~ retType
|
& reqReturnType .~ Just retType
|
||||||
where
|
where
|
||||||
retType = typeFor lang (Proxy :: Proxy a)
|
retType = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy a)
|
||||||
method = reflectMethod (Proxy :: Proxy method)
|
method = reflectMethod (Proxy :: Proxy method)
|
||||||
methodLC = toLower $ decodeUtf8 method
|
methodLC = toLower $ decodeUtf8 method
|
||||||
|
|
||||||
instance (KnownSymbol sym, HasForeignType lang a, HasForeign lang sublayout)
|
instance (KnownSymbol sym, HasForeignType lang ftype a, HasForeign lang ftype sublayout)
|
||||||
=> HasForeign lang (Header sym a :> sublayout) where
|
=> HasForeign lang ftype (Header sym a :> sublayout) where
|
||||||
type Foreign (Header sym a :> sublayout) = Foreign sublayout
|
type Foreign ftype (Header sym a :> sublayout) = Foreign ftype sublayout
|
||||||
|
|
||||||
foreignFor lang Proxy req =
|
foreignFor lang Proxy Proxy req =
|
||||||
foreignFor lang subP $ req & reqHeaders <>~ [HeaderArg arg]
|
foreignFor lang Proxy subP $ req & reqHeaders <>~ [HeaderArg arg]
|
||||||
where
|
where
|
||||||
hname = pack . symbolVal $ (Proxy :: Proxy sym)
|
hname = pack . symbolVal $ (Proxy :: Proxy sym)
|
||||||
arg = Arg
|
arg = Arg
|
||||||
{ _argName = PathSegment hname
|
{ _argName = PathSegment hname
|
||||||
, _argType = typeFor lang (Proxy :: Proxy a) }
|
, _argType = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy a) }
|
||||||
subP = Proxy :: Proxy sublayout
|
subP = Proxy :: Proxy sublayout
|
||||||
|
|
||||||
instance (KnownSymbol sym, HasForeignType lang a, HasForeign lang sublayout)
|
instance (KnownSymbol sym, HasForeignType lang ftype a, HasForeign lang ftype sublayout)
|
||||||
=> HasForeign lang (QueryParam sym a :> sublayout) where
|
=> HasForeign lang ftype (QueryParam sym a :> sublayout) where
|
||||||
type Foreign (QueryParam sym a :> sublayout) = Foreign sublayout
|
type Foreign ftype (QueryParam sym a :> sublayout) = Foreign ftype sublayout
|
||||||
|
|
||||||
foreignFor lang Proxy req =
|
foreignFor lang Proxy Proxy req =
|
||||||
foreignFor lang (Proxy :: Proxy sublayout) $
|
foreignFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy sublayout) $
|
||||||
req & reqUrl.queryStr <>~ [QueryArg arg Normal]
|
req & reqUrl.queryStr <>~ [QueryArg arg Normal]
|
||||||
where
|
where
|
||||||
str = pack . symbolVal $ (Proxy :: Proxy sym)
|
str = pack . symbolVal $ (Proxy :: Proxy sym)
|
||||||
arg = Arg
|
arg = Arg
|
||||||
{ _argName = PathSegment str
|
{ _argName = PathSegment str
|
||||||
, _argType = typeFor lang (Proxy :: Proxy a) }
|
, _argType = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy a) }
|
||||||
|
|
||||||
instance
|
instance
|
||||||
(KnownSymbol sym, HasForeignType lang [a], HasForeign lang sublayout)
|
(KnownSymbol sym, HasForeignType lang ftype [a], HasForeign lang ftype sublayout)
|
||||||
=> HasForeign lang (QueryParams sym a :> sublayout) where
|
=> HasForeign lang ftype (QueryParams sym a :> sublayout) where
|
||||||
type Foreign (QueryParams sym a :> sublayout) = Foreign sublayout
|
type Foreign ftype (QueryParams sym a :> sublayout) = Foreign ftype sublayout
|
||||||
foreignFor lang Proxy req =
|
foreignFor lang Proxy Proxy req =
|
||||||
foreignFor lang (Proxy :: Proxy sublayout) $
|
foreignFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy sublayout) $
|
||||||
req & reqUrl.queryStr <>~ [QueryArg arg List]
|
req & reqUrl.queryStr <>~ [QueryArg arg List]
|
||||||
where
|
where
|
||||||
str = pack . symbolVal $ (Proxy :: Proxy sym)
|
str = pack . symbolVal $ (Proxy :: Proxy sym)
|
||||||
arg = Arg
|
arg = Arg
|
||||||
{ _argName = PathSegment str
|
{ _argName = PathSegment str
|
||||||
, _argType = typeFor lang (Proxy :: Proxy [a]) }
|
, _argType = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy [a]) }
|
||||||
|
|
||||||
instance
|
instance
|
||||||
(KnownSymbol sym, HasForeignType lang Bool, HasForeign lang sublayout)
|
(KnownSymbol sym, HasForeignType lang ftype Bool, HasForeign lang ftype sublayout)
|
||||||
=> HasForeign lang (QueryFlag sym :> sublayout) where
|
=> HasForeign lang ftype (QueryFlag sym :> sublayout) where
|
||||||
type Foreign (QueryFlag sym :> sublayout) = Foreign sublayout
|
type Foreign ftype (QueryFlag sym :> sublayout) = Foreign ftype sublayout
|
||||||
|
|
||||||
foreignFor lang Proxy req =
|
foreignFor lang ftype Proxy req =
|
||||||
foreignFor lang (Proxy :: Proxy sublayout) $
|
foreignFor lang ftype (Proxy :: Proxy sublayout) $
|
||||||
req & reqUrl.queryStr <>~ [QueryArg arg Flag]
|
req & reqUrl.queryStr <>~ [QueryArg arg Flag]
|
||||||
where
|
where
|
||||||
str = pack . symbolVal $ (Proxy :: Proxy sym)
|
str = pack . symbolVal $ (Proxy :: Proxy sym)
|
||||||
arg = Arg
|
arg = Arg
|
||||||
{ _argName = PathSegment str
|
{ _argName = PathSegment str
|
||||||
, _argType = typeFor lang (Proxy :: Proxy Bool) }
|
, _argType = typeFor lang ftype (Proxy :: Proxy Bool) }
|
||||||
|
|
||||||
instance HasForeign lang Raw where
|
instance HasForeign lang ftype Raw where
|
||||||
type Foreign Raw = HTTP.Method -> Req Text
|
type Foreign ftype Raw = HTTP.Method -> Req ftype
|
||||||
|
|
||||||
foreignFor _ Proxy req method =
|
foreignFor _ Proxy Proxy req method =
|
||||||
req & reqFuncName . _FunctionName %~ ((toLower $ decodeUtf8 method) :)
|
req & reqFuncName . _FunctionName %~ ((toLower $ decodeUtf8 method) :)
|
||||||
& reqMethod .~ method
|
& reqMethod .~ method
|
||||||
|
|
||||||
instance (Elem JSON list, HasForeignType lang a, HasForeign lang sublayout)
|
instance (Elem JSON list, HasForeignType lang ftype a, HasForeign lang ftype sublayout)
|
||||||
=> HasForeign lang (ReqBody list a :> sublayout) where
|
=> HasForeign lang ftype (ReqBody list a :> sublayout) where
|
||||||
type Foreign (ReqBody list a :> sublayout) = Foreign sublayout
|
type Foreign ftype (ReqBody list a :> sublayout) = Foreign ftype sublayout
|
||||||
|
|
||||||
foreignFor lang Proxy req =
|
foreignFor lang ftype Proxy req =
|
||||||
foreignFor lang (Proxy :: Proxy sublayout) $
|
foreignFor lang ftype (Proxy :: Proxy sublayout) $
|
||||||
req & reqBody .~ (Just $ typeFor lang (Proxy :: Proxy a))
|
req & reqBody .~ (Just $ typeFor lang ftype (Proxy :: Proxy a))
|
||||||
|
|
||||||
instance (KnownSymbol path, HasForeign lang sublayout)
|
instance (KnownSymbol path, HasForeign lang ftype sublayout)
|
||||||
=> HasForeign lang (path :> sublayout) where
|
=> HasForeign lang ftype (path :> sublayout) where
|
||||||
type Foreign (path :> sublayout) = Foreign sublayout
|
type Foreign ftype (path :> sublayout) = Foreign ftype sublayout
|
||||||
|
|
||||||
foreignFor lang Proxy req =
|
foreignFor lang ftype Proxy req =
|
||||||
foreignFor lang (Proxy :: Proxy sublayout) $
|
foreignFor lang ftype (Proxy :: Proxy sublayout) $
|
||||||
req & reqUrl . path <>~ [Segment (Static (PathSegment str))]
|
req & reqUrl . path <>~ [Segment (Static (PathSegment str))]
|
||||||
& reqFuncName . _FunctionName %~ (++ [str])
|
& reqFuncName . _FunctionName %~ (++ [str])
|
||||||
where
|
where
|
||||||
|
@ -313,58 +304,59 @@ instance (KnownSymbol path, HasForeign lang sublayout)
|
||||||
Data.Text.map (\c -> if c == '.' then '_' else c)
|
Data.Text.map (\c -> if c == '.' then '_' else c)
|
||||||
. pack . symbolVal $ (Proxy :: Proxy path)
|
. pack . symbolVal $ (Proxy :: Proxy path)
|
||||||
|
|
||||||
instance HasForeign lang sublayout
|
instance HasForeign lang ftype sublayout
|
||||||
=> HasForeign lang (RemoteHost :> sublayout) where
|
=> HasForeign lang ftype (RemoteHost :> sublayout) where
|
||||||
type Foreign (RemoteHost :> sublayout) = Foreign sublayout
|
type Foreign ftype (RemoteHost :> sublayout) = Foreign ftype sublayout
|
||||||
|
|
||||||
foreignFor lang Proxy req =
|
foreignFor lang ftype Proxy req =
|
||||||
foreignFor lang (Proxy :: Proxy sublayout) req
|
foreignFor lang ftype (Proxy :: Proxy sublayout) req
|
||||||
|
|
||||||
instance HasForeign lang sublayout
|
instance HasForeign lang ftype sublayout
|
||||||
=> HasForeign lang (IsSecure :> sublayout) where
|
=> HasForeign lang ftype (IsSecure :> sublayout) where
|
||||||
type Foreign (IsSecure :> sublayout) = Foreign sublayout
|
type Foreign ftype (IsSecure :> sublayout) = Foreign ftype sublayout
|
||||||
|
|
||||||
foreignFor lang Proxy req =
|
foreignFor lang ftype Proxy req =
|
||||||
foreignFor lang (Proxy :: Proxy sublayout) req
|
foreignFor lang ftype (Proxy :: Proxy sublayout) req
|
||||||
|
|
||||||
instance HasForeign lang sublayout => HasForeign lang (Vault :> sublayout) where
|
instance HasForeign lang ftype sublayout => HasForeign lang ftype (Vault :> sublayout) where
|
||||||
type Foreign (Vault :> sublayout) = Foreign sublayout
|
type Foreign ftype (Vault :> sublayout) = Foreign ftype sublayout
|
||||||
|
|
||||||
foreignFor lang Proxy req =
|
foreignFor lang ftype Proxy req =
|
||||||
foreignFor lang (Proxy :: Proxy sublayout) req
|
foreignFor lang ftype (Proxy :: Proxy sublayout) req
|
||||||
|
|
||||||
instance HasForeign lang sublayout =>
|
instance HasForeign lang ftype sublayout =>
|
||||||
HasForeign lang (WithNamedContext name context sublayout) where
|
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
|
instance HasForeign lang ftype sublayout
|
||||||
=> HasForeign lang (HttpVersion :> sublayout) where
|
=> HasForeign lang ftype (HttpVersion :> sublayout) where
|
||||||
type Foreign (HttpVersion :> sublayout) = Foreign sublayout
|
type Foreign ftype (HttpVersion :> sublayout) = Foreign ftype sublayout
|
||||||
|
|
||||||
foreignFor lang Proxy req =
|
foreignFor lang ftype Proxy req =
|
||||||
foreignFor lang (Proxy :: Proxy sublayout) req
|
foreignFor lang ftype (Proxy :: Proxy sublayout) req
|
||||||
|
|
||||||
-- | Utility class used by 'listFromAPI' which computes
|
-- | Utility class used by 'listFromAPI' which computes
|
||||||
-- the data needed to generate a function for each endpoint
|
-- the data needed to generate a function for each endpoint
|
||||||
-- and hands it all back in a list.
|
-- and hands it all back in a list.
|
||||||
class GenerateList reqs where
|
class GenerateList ftype reqs where
|
||||||
generateList :: reqs -> [Req Text]
|
generateList :: reqs -> [Req ftype]
|
||||||
|
|
||||||
instance GenerateList (Req Text) where
|
instance GenerateList ftype (Req ftype) where
|
||||||
generateList r = [r]
|
generateList r = [r]
|
||||||
|
|
||||||
instance (GenerateList start, GenerateList rest)
|
instance (GenerateList ftype start, GenerateList ftype rest)
|
||||||
=> GenerateList (start :<|> rest) where
|
=> GenerateList ftype (start :<|> rest) where
|
||||||
generateList (start :<|> rest) = (generateList start) ++ (generateList rest)
|
generateList (start :<|> rest) = (generateList start) ++ (generateList rest)
|
||||||
|
|
||||||
-- | Generate the necessary data for codegen as a list, each 'Req'
|
-- | Generate the necessary data for codegen as a list, each 'Req'
|
||||||
-- describing one endpoint from your API type.
|
-- describing one endpoint from your API type.
|
||||||
listFromAPI
|
listFromAPI
|
||||||
:: (HasForeign lang api, GenerateList (Foreign api))
|
:: (HasForeign lang ftype api, GenerateList ftype (Foreign ftype api))
|
||||||
=> Proxy lang
|
=> Proxy lang
|
||||||
|
-> Proxy ftype
|
||||||
-> Proxy api
|
-> Proxy api
|
||||||
-> [Req Text]
|
-> [Req ftype]
|
||||||
listFromAPI lang p = generateList (foreignFor lang p defReq)
|
listFromAPI lang ftype p = generateList (foreignFor lang ftype p defReq)
|
||||||
|
|
|
@ -6,7 +6,6 @@ module Servant.ForeignSpec where
|
||||||
import Data.Monoid ((<>))
|
import Data.Monoid ((<>))
|
||||||
import Data.Proxy
|
import Data.Proxy
|
||||||
import Servant.Foreign
|
import Servant.Foreign
|
||||||
import Data.Text (Text(..))
|
|
||||||
|
|
||||||
import Test.Hspec
|
import Test.Hspec
|
||||||
|
|
||||||
|
@ -27,20 +26,20 @@ camelCaseSpec = describe "camelCase" $ do
|
||||||
|
|
||||||
data LangX
|
data LangX
|
||||||
|
|
||||||
instance HasForeignType LangX () where
|
instance HasForeignType LangX String () where
|
||||||
typeFor _ _ = ForeignType "voidX"
|
typeFor _ _ _ = "voidX"
|
||||||
|
|
||||||
instance HasForeignType LangX Int where
|
instance HasForeignType LangX String Int where
|
||||||
typeFor _ _ = "intX"
|
typeFor _ _ _ = "intX"
|
||||||
|
|
||||||
instance HasForeignType LangX Bool where
|
instance HasForeignType LangX String Bool where
|
||||||
typeFor _ _ = "boolX"
|
typeFor _ _ _ = "boolX"
|
||||||
|
|
||||||
instance OVERLAPPING_ HasForeignType LangX String where
|
instance OVERLAPPING_ HasForeignType LangX String String where
|
||||||
typeFor _ _ = "stringX"
|
typeFor _ _ _ = "stringX"
|
||||||
|
|
||||||
instance OVERLAPPABLE_ HasForeignType LangX a => HasForeignType LangX [a] where
|
instance OVERLAPPABLE_ HasForeignType LangX String a => HasForeignType LangX String [a] where
|
||||||
typeFor lang _ = "listX of " <> typeFor lang (Proxy :: Proxy a)
|
typeFor lang ftype _ = "listX of " <> typeFor lang ftype (Proxy :: Proxy a)
|
||||||
|
|
||||||
type TestApi
|
type TestApi
|
||||||
= "test" :> Header "header" [String] :> QueryFlag "flag" :> Get '[JSON] Int
|
= "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" :> QueryParams "params" Int :> ReqBody '[JSON] String :> Put '[JSON] ()
|
||||||
:<|> "test" :> Capture "id" Int :> Delete '[JSON] ()
|
:<|> "test" :> Capture "id" Int :> Delete '[JSON] ()
|
||||||
|
|
||||||
testApi :: [Req Text]
|
testApi :: [Req String]
|
||||||
testApi = listFromAPI (Proxy :: Proxy LangX) (Proxy :: Proxy TestApi)
|
testApi = listFromAPI (Proxy :: Proxy LangX) (Proxy :: Proxy String) (Proxy :: Proxy TestApi)
|
||||||
|
|
||||||
listFromAPISpec :: Spec
|
listFromAPISpec :: Spec
|
||||||
listFromAPISpec = describe "listFromAPI" $ do
|
listFromAPISpec = describe "listFromAPI" $ do
|
||||||
|
@ -66,7 +65,7 @@ listFromAPISpec = describe "listFromAPI" $ do
|
||||||
, _reqMethod = "GET"
|
, _reqMethod = "GET"
|
||||||
, _reqHeaders = [HeaderArg $ Arg "header" "listX of stringX"]
|
, _reqHeaders = [HeaderArg $ Arg "header" "listX of stringX"]
|
||||||
, _reqBody = Nothing
|
, _reqBody = Nothing
|
||||||
, _reqReturnType = "intX"
|
, _reqReturnType = Just "intX"
|
||||||
, _reqFuncName = FunctionName ["get", "test"]
|
, _reqFuncName = FunctionName ["get", "test"]
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -78,7 +77,7 @@ listFromAPISpec = describe "listFromAPI" $ do
|
||||||
, _reqMethod = "POST"
|
, _reqMethod = "POST"
|
||||||
, _reqHeaders = []
|
, _reqHeaders = []
|
||||||
, _reqBody = Just "listX of stringX"
|
, _reqBody = Just "listX of stringX"
|
||||||
, _reqReturnType = "voidX"
|
, _reqReturnType = Just "voidX"
|
||||||
, _reqFuncName = FunctionName ["post", "test"]
|
, _reqFuncName = FunctionName ["post", "test"]
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -91,7 +90,7 @@ listFromAPISpec = describe "listFromAPI" $ do
|
||||||
, _reqMethod = "PUT"
|
, _reqMethod = "PUT"
|
||||||
, _reqHeaders = []
|
, _reqHeaders = []
|
||||||
, _reqBody = Just "stringX"
|
, _reqBody = Just "stringX"
|
||||||
, _reqReturnType = "voidX"
|
, _reqReturnType = Just "voidX"
|
||||||
, _reqFuncName = FunctionName ["put", "test"]
|
, _reqFuncName = FunctionName ["put", "test"]
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -104,6 +103,6 @@ listFromAPISpec = describe "listFromAPI" $ do
|
||||||
, _reqMethod = "DELETE"
|
, _reqMethod = "DELETE"
|
||||||
, _reqHeaders = []
|
, _reqHeaders = []
|
||||||
, _reqBody = Nothing
|
, _reqBody = Nothing
|
||||||
, _reqReturnType = "voidX"
|
, _reqReturnType = Just "voidX"
|
||||||
, _reqFuncName = FunctionName ["delete", "test", "by", "id"]
|
, _reqFuncName = FunctionName ["delete", "test", "by", "id"]
|
||||||
}
|
}
|
||||||
|
|
|
@ -128,22 +128,22 @@ import Servant.Foreign (GenerateList(..), listFromAPI, NoTypes)
|
||||||
-- | Generate the data necessary to generate javascript code
|
-- | Generate the data necessary to generate javascript code
|
||||||
-- for all the endpoints of an API, as ':<|>'-separated values
|
-- for all the endpoints of an API, as ':<|>'-separated values
|
||||||
-- of type 'AjaxReq'.
|
-- of type 'AjaxReq'.
|
||||||
javascript :: HasForeign NoTypes layout => Proxy layout -> Foreign layout
|
javascript :: HasForeign NoTypes () layout => Proxy layout -> Foreign () layout
|
||||||
javascript p = foreignFor (Proxy :: Proxy NoTypes) p defReq
|
javascript p = foreignFor (Proxy :: Proxy NoTypes) (Proxy :: Proxy ()) p defReq
|
||||||
|
|
||||||
-- | Directly generate all the javascript functions for your API
|
-- | Directly generate all the javascript functions for your API
|
||||||
-- from a 'Proxy' for your API type. You can then write it to
|
-- from a 'Proxy' for your API type. You can then write it to
|
||||||
-- a file or integrate it in a page, for example.
|
-- 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
|
=> Proxy api -- ^ proxy for your API type
|
||||||
-> JavaScriptGenerator -- ^ js code generator to use (angular, vanilla js, jquery, others)
|
-> 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
|
-> 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
|
-- | Directly generate all the javascript functions for your API
|
||||||
-- from a 'Proxy' for your API type using the given generator
|
-- from a 'Proxy' for your API type using the given generator
|
||||||
-- and write the resulting code to a file at the given path.
|
-- 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
|
=> Proxy api -- ^ proxy for your API type
|
||||||
-> JavaScriptGenerator -- ^ js code generator to use (angular, vanilla js, jquery, others)
|
-> 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
|
-> FilePath -- ^ path to the file you want to write the resulting javascript code into
|
||||||
|
|
|
@ -21,7 +21,6 @@ module Servant.JS.Internal
|
||||||
, reqHeaders
|
, reqHeaders
|
||||||
, HasForeign(..)
|
, HasForeign(..)
|
||||||
, HasForeignType(..)
|
, HasForeignType(..)
|
||||||
, HasNoForeignType
|
|
||||||
, GenerateList(..)
|
, GenerateList(..)
|
||||||
, NoTypes
|
, NoTypes
|
||||||
, HeaderArg
|
, HeaderArg
|
||||||
|
@ -33,7 +32,6 @@ module Servant.JS.Internal
|
||||||
, SegmentType(..)
|
, SegmentType(..)
|
||||||
, Url(..)
|
, Url(..)
|
||||||
, Path
|
, Path
|
||||||
, ForeignType(..)
|
|
||||||
, Arg(..)
|
, Arg(..)
|
||||||
, FunctionName(..)
|
, FunctionName(..)
|
||||||
, PathSegment(..)
|
, PathSegment(..)
|
||||||
|
@ -57,12 +55,12 @@ import qualified Data.Text as T
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import Servant.Foreign
|
import Servant.Foreign
|
||||||
|
|
||||||
type AjaxReq = Req Text
|
type AjaxReq = Req ()
|
||||||
|
|
||||||
-- A 'JavascriptGenerator' just takes the data found in the API type
|
-- A 'JavascriptGenerator' just takes the data found in the API type
|
||||||
-- for each endpoint and generates Javascript code in a Text. Several
|
-- for each endpoint and generates Javascript code in a Text. Several
|
||||||
-- generators are available in this package.
|
-- 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
|
-- | This structure is used by specific implementations to let you
|
||||||
-- customize the output
|
-- customize the output
|
||||||
|
|
|
@ -106,7 +106,7 @@ a `shouldNotContain` b = shouldNotSatisfy a (T.isInfixOf b)
|
||||||
|
|
||||||
axiosSpec :: Spec
|
axiosSpec :: Spec
|
||||||
axiosSpec = describe specLabel $ do
|
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
|
it "should add withCredentials when needed" $ do
|
||||||
let jsText = genJS withCredOpts $ reqList
|
let jsText = genJS withCredOpts $ reqList
|
||||||
output jsText
|
output jsText
|
||||||
|
@ -130,7 +130,7 @@ axiosSpec = describe specLabel $ do
|
||||||
|
|
||||||
angularSpec :: TestNames -> Spec
|
angularSpec :: TestNames -> Spec
|
||||||
angularSpec test = describe specLabel $ do
|
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
|
it "should implement a service globally" $ do
|
||||||
let jsText = genJS reqList
|
let jsText = genJS reqList
|
||||||
output jsText
|
output jsText
|
||||||
|
|
|
@ -1,4 +1,5 @@
|
||||||
{-# LANGUAGE DataKinds #-}
|
{-# LANGUAGE DataKinds #-}
|
||||||
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
{-# LANGUAGE FlexibleInstances #-}
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
{-# LANGUAGE KindSignatures #-}
|
{-# LANGUAGE KindSignatures #-}
|
||||||
{-# LANGUAGE PolyKinds #-}
|
{-# LANGUAGE PolyKinds #-}
|
||||||
|
@ -22,13 +23,13 @@ import Servant.JS.Internal
|
||||||
-- using -- Basic, Digest, whatever.
|
-- using -- Basic, Digest, whatever.
|
||||||
data Authorization (sym :: Symbol) a
|
data Authorization (sym :: Symbol) a
|
||||||
|
|
||||||
instance (KnownSymbol sym, HasForeign lang sublayout)
|
instance (KnownSymbol sym, HasForeign lang () sublayout)
|
||||||
=> HasForeign lang (Authorization sym a :> sublayout) where
|
=> HasForeign lang () (Authorization sym a :> sublayout) where
|
||||||
type Foreign (Authorization sym a :> sublayout) = Foreign sublayout
|
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 <>~
|
req & reqHeaders <>~
|
||||||
[ ReplaceHeaderArg (Arg "Authorization" "")
|
[ ReplaceHeaderArg (Arg "Authorization" ())
|
||||||
$ tokenType (pack . symbolVal $ (Proxy :: Proxy sym)) ]
|
$ tokenType (pack . symbolVal $ (Proxy :: Proxy sym)) ]
|
||||||
where
|
where
|
||||||
tokenType t = t <> " {Authorization}"
|
tokenType t = t <> " {Authorization}"
|
||||||
|
@ -36,23 +37,23 @@ instance (KnownSymbol sym, HasForeign lang sublayout)
|
||||||
-- | This is a combinator that fetches an X-MyLovelyHorse header.
|
-- | This is a combinator that fetches an X-MyLovelyHorse header.
|
||||||
data MyLovelyHorse a
|
data MyLovelyHorse a
|
||||||
|
|
||||||
instance (HasForeign lang sublayout)
|
instance (HasForeign lang () sublayout)
|
||||||
=> HasForeign lang (MyLovelyHorse a :> sublayout) where
|
=> HasForeign lang () (MyLovelyHorse a :> sublayout) where
|
||||||
type Foreign (MyLovelyHorse a :> sublayout) = Foreign sublayout
|
type Foreign () (MyLovelyHorse 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 "X-MyLovelyHorse" "") tpl ]
|
req & reqHeaders <>~ [ ReplaceHeaderArg (Arg "X-MyLovelyHorse" ()) tpl ]
|
||||||
where
|
where
|
||||||
tpl = "I am good friends with {X-MyLovelyHorse}"
|
tpl = "I am good friends with {X-MyLovelyHorse}"
|
||||||
|
|
||||||
-- | This is a combinator that fetches an X-WhatsForDinner header.
|
-- | This is a combinator that fetches an X-WhatsForDinner header.
|
||||||
data WhatsForDinner a
|
data WhatsForDinner a
|
||||||
|
|
||||||
instance (HasForeign lang sublayout)
|
instance (HasForeign lang () sublayout)
|
||||||
=> HasForeign lang (WhatsForDinner a :> sublayout) where
|
=> HasForeign lang () (WhatsForDinner a :> sublayout) where
|
||||||
type Foreign (WhatsForDinner a :> sublayout) = Foreign sublayout
|
type Foreign () (WhatsForDinner 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 "X-WhatsForDinner" "") tpl ]
|
req & reqHeaders <>~ [ ReplaceHeaderArg (Arg "X-WhatsForDinner" ()) tpl ]
|
||||||
where
|
where
|
||||||
tpl = "I would like {X-WhatsForDinner} with a cherry on top."
|
tpl = "I would like {X-WhatsForDinner} with a cherry on top."
|
||||||
|
|
Loading…
Reference in a new issue