Merge pull request #277 from MaxOw/master
Type information in servant-foreign.
This commit is contained in:
commit
1bd2d913de
13 changed files with 338 additions and 154 deletions
|
@ -11,7 +11,7 @@ description:
|
||||||
<https://github.com/haskell-servant/servant/blob/master/servant-foreign/CHANGELOG.md CHANGELOG>
|
<https://github.com/haskell-servant/servant/blob/master/servant-foreign/CHANGELOG.md CHANGELOG>
|
||||||
license: BSD3
|
license: BSD3
|
||||||
license-file: LICENSE
|
license-file: LICENSE
|
||||||
author: Denis Redozubov
|
author: Denis Redozubov, Maksymilian Owsianny
|
||||||
maintainer: denis.redozubov@gmail.com
|
maintainer: denis.redozubov@gmail.com
|
||||||
copyright: 2015 Denis Redozubov, Alp Mestanogullari
|
copyright: 2015 Denis Redozubov, Alp Mestanogullari
|
||||||
category: Web
|
category: Web
|
||||||
|
|
|
@ -2,6 +2,7 @@
|
||||||
-- arbitrary programming languages.
|
-- arbitrary programming languages.
|
||||||
module Servant.Foreign
|
module Servant.Foreign
|
||||||
( HasForeign(..)
|
( HasForeign(..)
|
||||||
|
, HasForeignType(..)
|
||||||
, Segment(..)
|
, Segment(..)
|
||||||
, SegmentType(..)
|
, SegmentType(..)
|
||||||
, FunctionName
|
, FunctionName
|
||||||
|
@ -24,8 +25,12 @@ module Servant.Foreign
|
||||||
, reqBody
|
, reqBody
|
||||||
, reqHeaders
|
, reqHeaders
|
||||||
, reqMethod
|
, reqMethod
|
||||||
|
, reqReturnType
|
||||||
, segment
|
, segment
|
||||||
, queryStr
|
, queryStr
|
||||||
|
, listFromAPI
|
||||||
|
, GenerateList(..)
|
||||||
|
, NoTypes
|
||||||
-- re-exports
|
-- re-exports
|
||||||
, module Servant.API
|
, module Servant.API
|
||||||
) where
|
) where
|
||||||
|
|
|
@ -45,7 +45,8 @@ camelCase = camelCase' . Prelude.map (replace "-" "")
|
||||||
capitalize "" = ""
|
capitalize "" = ""
|
||||||
capitalize name = C.toUpper (Data.Text.head name) `cons` Data.Text.tail name
|
capitalize name = C.toUpper (Data.Text.head name) `cons` Data.Text.tail name
|
||||||
|
|
||||||
type Arg = Text
|
type ForeignType = Text
|
||||||
|
type Arg = (Text, ForeignType)
|
||||||
|
|
||||||
newtype Segment = Segment { _segment :: SegmentType }
|
newtype Segment = Segment { _segment :: SegmentType }
|
||||||
deriving (Eq, Show)
|
deriving (Eq, Show)
|
||||||
|
@ -68,10 +69,10 @@ data QueryArg = QueryArg
|
||||||
} deriving (Eq, Show)
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
data HeaderArg = HeaderArg
|
data HeaderArg = HeaderArg
|
||||||
{ headerArgName :: Text
|
{ headerArg :: Arg
|
||||||
}
|
}
|
||||||
| ReplaceHeaderArg
|
| ReplaceHeaderArg
|
||||||
{ headerArgName :: Text
|
{ headerArg :: Arg
|
||||||
, headerPattern :: Text
|
, headerPattern :: Text
|
||||||
} deriving (Eq, Show)
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
|
@ -88,11 +89,12 @@ type FunctionName = [Text]
|
||||||
type Method = Text
|
type Method = Text
|
||||||
|
|
||||||
data Req = Req
|
data Req = Req
|
||||||
{ _reqUrl :: Url
|
{ _reqUrl :: Url
|
||||||
, _reqMethod :: Method
|
, _reqMethod :: Method
|
||||||
, _reqHeaders :: [HeaderArg]
|
, _reqHeaders :: [HeaderArg]
|
||||||
, _reqBody :: Bool
|
, _reqBody :: Maybe ForeignType
|
||||||
, _funcName :: FunctionName
|
, _reqReturnType :: ForeignType
|
||||||
|
, _funcName :: FunctionName
|
||||||
} deriving (Eq, Show)
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
makeLenses ''QueryArg
|
makeLenses ''QueryArg
|
||||||
|
@ -109,7 +111,7 @@ captureArg (Segment (Cap s)) = s
|
||||||
captureArg _ = error "captureArg called on non capture"
|
captureArg _ = error "captureArg called on non capture"
|
||||||
|
|
||||||
defReq :: Req
|
defReq :: Req
|
||||||
defReq = Req defUrl "GET" [] False []
|
defReq = Req defUrl "GET" [] Nothing "" []
|
||||||
|
|
||||||
-- | 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.
|
||||||
|
@ -120,142 +122,228 @@ type family Elem (a :: *) (ls::[*]) :: Constraint where
|
||||||
Elem a (a ': list) = ()
|
Elem a (a ': list) = ()
|
||||||
Elem a (b ': list) = Elem a list
|
Elem a (b ': list) = Elem a list
|
||||||
|
|
||||||
class HasForeign (layout :: *) where
|
-- | 'HasForeignType' maps Haskell types with types in the target
|
||||||
type Foreign layout :: *
|
-- language of your backend. For example, let's say you're
|
||||||
foreignFor :: Proxy layout -> Req -> Foreign layout
|
-- implementing a backend to some language __X__:
|
||||||
|
--
|
||||||
|
-- > -- 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"
|
||||||
|
-- >
|
||||||
|
-- > -- Or for example in case of lists
|
||||||
|
-- > instance HasForeignType LangX a => HasForeignType LangX [a] where
|
||||||
|
-- > typeFor lang _ = "listX of " <> typeFor lang (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
|
||||||
|
--
|
||||||
|
-- > -- 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
|
||||||
|
-- >
|
||||||
|
--
|
||||||
|
class HasForeignType lang a where
|
||||||
|
typeFor :: Proxy lang -> Proxy a -> ForeignType
|
||||||
|
|
||||||
instance (HasForeign a, HasForeign b)
|
data NoTypes
|
||||||
=> HasForeign (a :<|> b) where
|
|
||||||
|
instance HasForeignType NoTypes a where
|
||||||
|
typeFor _ _ = empty
|
||||||
|
|
||||||
|
class HasForeign lang (layout :: *) where
|
||||||
|
type Foreign layout :: *
|
||||||
|
foreignFor :: Proxy lang -> Proxy layout -> Req -> Foreign layout
|
||||||
|
|
||||||
|
instance (HasForeign lang a, HasForeign lang b)
|
||||||
|
=> HasForeign lang (a :<|> b) where
|
||||||
type Foreign (a :<|> b) = Foreign a :<|> Foreign b
|
type Foreign (a :<|> b) = Foreign a :<|> Foreign b
|
||||||
|
|
||||||
foreignFor Proxy req =
|
foreignFor lang Proxy req =
|
||||||
foreignFor (Proxy :: Proxy a) req
|
foreignFor lang (Proxy :: Proxy a) req
|
||||||
:<|> foreignFor (Proxy :: Proxy b) req
|
:<|> foreignFor lang (Proxy :: Proxy b) req
|
||||||
|
|
||||||
instance (KnownSymbol sym, HasForeign sublayout)
|
instance (KnownSymbol sym, HasForeignType lang a, HasForeign lang sublayout)
|
||||||
=> HasForeign (Capture sym a :> sublayout) where
|
=> HasForeign lang (Capture sym a :> sublayout) where
|
||||||
type Foreign (Capture sym a :> sublayout) = Foreign sublayout
|
type Foreign (Capture sym a :> sublayout) = Foreign sublayout
|
||||||
|
|
||||||
foreignFor Proxy req =
|
foreignFor lang Proxy req =
|
||||||
foreignFor (Proxy :: Proxy sublayout) $
|
foreignFor lang (Proxy :: Proxy sublayout) $
|
||||||
req & reqUrl.path <>~ [Segment (Cap str)]
|
req & reqUrl.path <>~ [Segment (Cap arg)]
|
||||||
& funcName %~ (++ ["by", str])
|
& funcName %~ (++ ["by", str])
|
||||||
|
|
||||||
where str = pack . symbolVal $ (Proxy :: Proxy sym)
|
where
|
||||||
|
str = pack . symbolVal $ (Proxy :: Proxy sym)
|
||||||
|
arg = (str, typeFor lang (Proxy :: Proxy a))
|
||||||
|
|
||||||
instance Elem JSON list => HasForeign (Delete list a) where
|
instance (Elem JSON list, HasForeignType lang a)
|
||||||
|
=> HasForeign lang (Delete list a) where
|
||||||
type Foreign (Delete list a) = Req
|
type Foreign (Delete list a) = Req
|
||||||
|
|
||||||
foreignFor Proxy req =
|
foreignFor lang Proxy req =
|
||||||
req & funcName %~ ("delete" :)
|
req & funcName %~ ("delete" :)
|
||||||
& reqMethod .~ "DELETE"
|
& reqMethod .~ "DELETE"
|
||||||
|
& reqReturnType .~ retType
|
||||||
|
where
|
||||||
|
retType = typeFor lang (Proxy :: Proxy a)
|
||||||
|
|
||||||
instance Elem JSON list => HasForeign (Get list a) where
|
instance (Elem JSON list, HasForeignType lang a)
|
||||||
|
=> HasForeign lang (Get list a) where
|
||||||
type Foreign (Get list a) = Req
|
type Foreign (Get list a) = Req
|
||||||
|
|
||||||
foreignFor Proxy req =
|
foreignFor lang Proxy req =
|
||||||
req & funcName %~ ("get" :)
|
req & funcName %~ ("get" :)
|
||||||
& reqMethod .~ "GET"
|
& reqMethod .~ "GET"
|
||||||
|
& reqReturnType .~ retType
|
||||||
|
where
|
||||||
|
retType = typeFor lang (Proxy :: Proxy a)
|
||||||
|
|
||||||
instance (KnownSymbol sym, HasForeign sublayout)
|
instance (KnownSymbol sym, HasForeignType lang a, HasForeign lang sublayout)
|
||||||
=> HasForeign (Header sym a :> sublayout) where
|
=> HasForeign lang (Header sym a :> sublayout) where
|
||||||
type Foreign (Header sym a :> sublayout) = Foreign sublayout
|
type Foreign (Header sym a :> sublayout) = Foreign sublayout
|
||||||
|
|
||||||
foreignFor Proxy req =
|
foreignFor lang Proxy req =
|
||||||
foreignFor subP (req & reqHeaders <>~ [HeaderArg hname])
|
foreignFor lang subP $ req
|
||||||
|
& reqHeaders <>~ [HeaderArg arg]
|
||||||
|
|
||||||
where hname = pack . symbolVal $ (Proxy :: Proxy sym)
|
where
|
||||||
subP = Proxy :: Proxy sublayout
|
hname = pack . symbolVal $ (Proxy :: Proxy sym)
|
||||||
|
arg = (hname, typeFor lang (Proxy :: Proxy a))
|
||||||
|
subP = Proxy :: Proxy sublayout
|
||||||
|
|
||||||
instance Elem JSON list => HasForeign (Post list a) where
|
instance (Elem JSON list, HasForeignType lang a)
|
||||||
|
=> HasForeign lang (Post list a) where
|
||||||
type Foreign (Post list a) = Req
|
type Foreign (Post list a) = Req
|
||||||
|
|
||||||
foreignFor Proxy req =
|
foreignFor lang Proxy req =
|
||||||
req & funcName %~ ("post" :)
|
req & funcName %~ ("post" :)
|
||||||
& reqMethod .~ "POST"
|
& reqMethod .~ "POST"
|
||||||
|
& reqReturnType .~ retType
|
||||||
|
where
|
||||||
|
retType = typeFor lang (Proxy :: Proxy a)
|
||||||
|
|
||||||
instance Elem JSON list => HasForeign (Put list a) where
|
instance (Elem JSON list, HasForeignType lang a)
|
||||||
|
=> HasForeign lang (Put list a) where
|
||||||
type Foreign (Put list a) = Req
|
type Foreign (Put list a) = Req
|
||||||
|
|
||||||
foreignFor Proxy req =
|
foreignFor lang Proxy req =
|
||||||
req & funcName %~ ("put" :)
|
req & funcName %~ ("put" :)
|
||||||
& reqMethod .~ "PUT"
|
& reqMethod .~ "PUT"
|
||||||
|
& reqReturnType .~ retType
|
||||||
|
where
|
||||||
|
retType = typeFor lang (Proxy :: Proxy a)
|
||||||
|
|
||||||
instance (KnownSymbol sym, HasForeign sublayout)
|
instance (KnownSymbol sym, HasForeignType lang a, HasForeign lang sublayout)
|
||||||
=> HasForeign (QueryParam sym a :> sublayout) where
|
=> HasForeign lang (QueryParam sym a :> sublayout) where
|
||||||
type Foreign (QueryParam sym a :> sublayout) = Foreign sublayout
|
type Foreign (QueryParam sym a :> sublayout) = Foreign sublayout
|
||||||
|
|
||||||
foreignFor Proxy req =
|
foreignFor lang Proxy req =
|
||||||
foreignFor (Proxy :: Proxy sublayout) $
|
foreignFor lang (Proxy :: Proxy sublayout) $
|
||||||
req & reqUrl.queryStr <>~ [QueryArg str Normal]
|
req & reqUrl.queryStr <>~ [QueryArg arg Normal]
|
||||||
|
|
||||||
where str = pack . symbolVal $ (Proxy :: Proxy sym)
|
where
|
||||||
|
str = pack . symbolVal $ (Proxy :: Proxy sym)
|
||||||
|
arg = (str, typeFor lang (Proxy :: Proxy a))
|
||||||
|
|
||||||
instance (KnownSymbol sym, HasForeign sublayout)
|
instance (KnownSymbol sym, HasForeignType lang [a], HasForeign lang sublayout)
|
||||||
=> HasForeign (QueryParams sym a :> sublayout) where
|
=> HasForeign lang (QueryParams sym a :> sublayout) where
|
||||||
type Foreign (QueryParams sym a :> sublayout) = Foreign sublayout
|
type Foreign (QueryParams sym a :> sublayout) = Foreign sublayout
|
||||||
|
|
||||||
foreignFor Proxy req =
|
foreignFor lang Proxy req =
|
||||||
foreignFor (Proxy :: Proxy sublayout) $
|
foreignFor lang (Proxy :: Proxy sublayout) $
|
||||||
req & reqUrl.queryStr <>~ [QueryArg str List]
|
req & reqUrl.queryStr <>~ [QueryArg arg List]
|
||||||
|
|
||||||
where str = pack . symbolVal $ (Proxy :: Proxy sym)
|
where
|
||||||
|
str = pack . symbolVal $ (Proxy :: Proxy sym)
|
||||||
|
arg = (str, typeFor lang (Proxy :: Proxy [a]))
|
||||||
|
|
||||||
instance (KnownSymbol sym, HasForeign sublayout)
|
instance (KnownSymbol sym, HasForeignType lang a, a ~ Bool, HasForeign lang sublayout)
|
||||||
=> HasForeign (QueryFlag sym :> sublayout) where
|
=> HasForeign lang (QueryFlag sym :> sublayout) where
|
||||||
type Foreign (QueryFlag sym :> sublayout) = Foreign sublayout
|
type Foreign (QueryFlag sym :> sublayout) = Foreign sublayout
|
||||||
|
|
||||||
foreignFor Proxy req =
|
foreignFor lang Proxy req =
|
||||||
foreignFor (Proxy :: Proxy sublayout) $
|
foreignFor lang (Proxy :: Proxy sublayout) $
|
||||||
req & reqUrl.queryStr <>~ [QueryArg str Flag]
|
req & reqUrl.queryStr <>~ [QueryArg arg Flag]
|
||||||
|
|
||||||
where str = pack . symbolVal $ (Proxy :: Proxy sym)
|
where
|
||||||
|
str = pack . symbolVal $ (Proxy :: Proxy sym)
|
||||||
|
arg = (str, typeFor lang (Proxy :: Proxy a))
|
||||||
|
|
||||||
instance HasForeign Raw where
|
instance HasForeign lang Raw where
|
||||||
type Foreign Raw = Method -> Req
|
type Foreign Raw = Method -> Req
|
||||||
|
|
||||||
foreignFor Proxy req method =
|
foreignFor _ Proxy req method =
|
||||||
req & funcName %~ ((toLower method) :)
|
req & funcName %~ ((toLower method) :)
|
||||||
& reqMethod .~ method
|
& reqMethod .~ method
|
||||||
|
|
||||||
instance (Elem JSON list, HasForeign sublayout) => HasForeign (ReqBody list a :> sublayout) where
|
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
|
type Foreign (ReqBody list a :> sublayout) = Foreign sublayout
|
||||||
|
|
||||||
foreignFor Proxy req =
|
foreignFor lang Proxy req =
|
||||||
foreignFor (Proxy :: Proxy sublayout) $
|
foreignFor lang (Proxy :: Proxy sublayout) $
|
||||||
req & reqBody .~ True
|
req & reqBody .~ (Just $ typeFor lang (Proxy :: Proxy a))
|
||||||
|
|
||||||
instance (KnownSymbol path, HasForeign sublayout)
|
instance (KnownSymbol path, HasForeign lang sublayout)
|
||||||
=> HasForeign (path :> sublayout) where
|
=> HasForeign lang (path :> sublayout) where
|
||||||
type Foreign (path :> sublayout) = Foreign sublayout
|
type Foreign (path :> sublayout) = Foreign sublayout
|
||||||
|
|
||||||
foreignFor Proxy req =
|
foreignFor lang Proxy req =
|
||||||
foreignFor (Proxy :: Proxy sublayout) $
|
foreignFor lang (Proxy :: Proxy sublayout) $
|
||||||
req & reqUrl.path <>~ [Segment (Static str)]
|
req & reqUrl.path <>~ [Segment (Static str)]
|
||||||
& funcName %~ (++ [str])
|
& funcName %~ (++ [str])
|
||||||
|
|
||||||
where str = Data.Text.map (\c -> if c == '.' then '_' else c) . pack . symbolVal $ (Proxy :: Proxy path)
|
where
|
||||||
|
str = Data.Text.map (\c -> if c == '.' then '_' else c)
|
||||||
|
. pack . symbolVal $ (Proxy :: Proxy path)
|
||||||
|
|
||||||
instance HasForeign sublayout => HasForeign (RemoteHost :> sublayout) where
|
instance HasForeign lang sublayout => HasForeign lang (RemoteHost :> sublayout) where
|
||||||
type Foreign (RemoteHost :> sublayout) = Foreign sublayout
|
type Foreign (RemoteHost :> sublayout) = Foreign sublayout
|
||||||
|
|
||||||
foreignFor Proxy req =
|
foreignFor lang Proxy req =
|
||||||
foreignFor (Proxy :: Proxy sublayout) req
|
foreignFor lang (Proxy :: Proxy sublayout) req
|
||||||
|
|
||||||
instance HasForeign sublayout => HasForeign (IsSecure :> sublayout) where
|
instance HasForeign lang sublayout => HasForeign lang (IsSecure :> sublayout) where
|
||||||
type Foreign (IsSecure :> sublayout) = Foreign sublayout
|
type Foreign (IsSecure :> sublayout) = Foreign sublayout
|
||||||
|
|
||||||
foreignFor Proxy req =
|
foreignFor lang Proxy req =
|
||||||
foreignFor (Proxy :: Proxy sublayout) req
|
foreignFor lang (Proxy :: Proxy sublayout) req
|
||||||
|
|
||||||
instance HasForeign sublayout => HasForeign (Vault :> sublayout) where
|
instance HasForeign lang sublayout => HasForeign lang (Vault :> sublayout) where
|
||||||
type Foreign (Vault :> sublayout) = Foreign sublayout
|
type Foreign (Vault :> sublayout) = Foreign sublayout
|
||||||
|
|
||||||
foreignFor Proxy req =
|
foreignFor lang Proxy req =
|
||||||
foreignFor (Proxy :: Proxy sublayout) req
|
foreignFor lang (Proxy :: Proxy sublayout) req
|
||||||
|
|
||||||
instance HasForeign sublayout => HasForeign (HttpVersion :> sublayout) where
|
instance HasForeign lang sublayout => HasForeign lang (HttpVersion :> sublayout) where
|
||||||
type Foreign (HttpVersion :> sublayout) = Foreign sublayout
|
type Foreign (HttpVersion :> sublayout) = Foreign sublayout
|
||||||
|
|
||||||
foreignFor Proxy req =
|
foreignFor lang Proxy req =
|
||||||
foreignFor (Proxy :: Proxy sublayout) req
|
foreignFor lang (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]
|
||||||
|
|
||||||
|
instance GenerateList Req where
|
||||||
|
generateList r = [r]
|
||||||
|
|
||||||
|
instance (GenerateList start, GenerateList rest) => GenerateList (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)) => Proxy lang -> Proxy api -> [Req]
|
||||||
|
listFromAPI lang p = generateList (foreignFor lang p defReq)
|
||||||
|
|
||||||
|
|
|
@ -1,17 +1,114 @@
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE TypeOperators #-}
|
||||||
|
{-# LANGUAGE DataKinds #-}
|
||||||
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||||
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
|
{-# LANGUAGE TypeSynonymInstances #-}
|
||||||
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
|
{-# LANGUAGE CPP #-}
|
||||||
|
#if __GLASGOW_HASKELL__ < 710
|
||||||
|
{-# LANGUAGE OverlappingInstances #-}
|
||||||
|
#endif
|
||||||
|
|
||||||
module Servant.ForeignSpec where
|
module Servant.ForeignSpec where
|
||||||
|
|
||||||
import Servant.Foreign (camelCase)
|
import Data.Monoid ((<>))
|
||||||
|
import Data.Proxy
|
||||||
|
import Servant.Foreign
|
||||||
|
import Servant.Foreign.Internal
|
||||||
|
|
||||||
import Test.Hspec
|
import Test.Hspec
|
||||||
|
|
||||||
spec :: Spec
|
spec :: Spec
|
||||||
spec = describe "Servant.Foreign" $ do
|
spec = describe "Servant.Foreign" $ do
|
||||||
camelCaseSpec
|
camelCaseSpec
|
||||||
|
listFromAPISpec
|
||||||
|
|
||||||
camelCaseSpec :: Spec
|
camelCaseSpec :: Spec
|
||||||
camelCaseSpec = describe "camelCase" $ do
|
camelCaseSpec = describe "camelCase" $ do
|
||||||
it "converts FunctionNames to camelCase" $ do
|
it "converts FunctionNames to camelCase" $ do
|
||||||
camelCase ["post", "counter", "inc"] `shouldBe` "postCounterInc"
|
camelCase ["post", "counter", "inc"] `shouldBe` "postCounterInc"
|
||||||
camelCase ["get", "hyphen-ated", "counter"] `shouldBe` "getHyphenatedCounter"
|
camelCase ["get", "hyphen-ated", "counter"] `shouldBe` "getHyphenatedCounter"
|
||||||
|
|
||||||
|
----------------------------------------------------------------------
|
||||||
|
|
||||||
|
data LangX
|
||||||
|
|
||||||
|
instance HasForeignType LangX () where
|
||||||
|
typeFor _ _ = "voidX"
|
||||||
|
instance HasForeignType LangX Int where
|
||||||
|
typeFor _ _ = "intX"
|
||||||
|
instance HasForeignType LangX Bool where
|
||||||
|
typeFor _ _ = "boolX"
|
||||||
|
instance {-# Overlapping #-} HasForeignType LangX String where
|
||||||
|
typeFor _ _ = "stringX"
|
||||||
|
instance {-# Overlappable #-} HasForeignType LangX a => HasForeignType LangX [a] where
|
||||||
|
typeFor lang _ = "listX of " <> typeFor lang (Proxy :: Proxy a)
|
||||||
|
|
||||||
|
type TestApi
|
||||||
|
= "test" :> Header "header" [String] :> QueryFlag "flag" :> Get '[JSON] Int
|
||||||
|
:<|> "test" :> QueryParam "param" Int :> ReqBody '[JSON] [String] :> Post '[JSON] ()
|
||||||
|
:<|> "test" :> QueryParams "params" Int :> ReqBody '[JSON] String :> Put '[JSON] ()
|
||||||
|
:<|> "test" :> Capture "id" Int :> Delete '[JSON] ()
|
||||||
|
|
||||||
|
testApi :: [Req]
|
||||||
|
testApi = listFromAPI (Proxy :: Proxy LangX) (Proxy :: Proxy TestApi)
|
||||||
|
|
||||||
|
listFromAPISpec :: Spec
|
||||||
|
listFromAPISpec = describe "listFromAPI" $ do
|
||||||
|
it "generates 4 endpoints for TestApi" $ do
|
||||||
|
length testApi `shouldBe` 4
|
||||||
|
|
||||||
|
let [getReq, postReq, putReq, deleteReq] = testApi
|
||||||
|
|
||||||
|
it "collects all info for get request" $ do
|
||||||
|
shouldBe getReq $ defReq
|
||||||
|
{ _reqUrl = Url
|
||||||
|
[ Segment $ Static "test" ]
|
||||||
|
[ QueryArg ("flag", "boolX") Flag ]
|
||||||
|
, _reqMethod = "GET"
|
||||||
|
, _reqHeaders = [HeaderArg ("header", "listX of stringX")]
|
||||||
|
, _reqBody = Nothing
|
||||||
|
, _reqReturnType = "intX"
|
||||||
|
, _funcName = ["get", "test"]
|
||||||
|
}
|
||||||
|
|
||||||
|
it "collects all info for post request" $ do
|
||||||
|
shouldBe postReq $ defReq
|
||||||
|
{ _reqUrl = Url
|
||||||
|
[ Segment $ Static "test" ]
|
||||||
|
[ QueryArg ("param", "intX") Normal ]
|
||||||
|
, _reqMethod = "POST"
|
||||||
|
, _reqHeaders = []
|
||||||
|
, _reqBody = Just "listX of stringX"
|
||||||
|
, _reqReturnType = "voidX"
|
||||||
|
, _funcName = ["post", "test"]
|
||||||
|
}
|
||||||
|
|
||||||
|
it "collects all info for put request" $ do
|
||||||
|
shouldBe putReq $ defReq
|
||||||
|
{ _reqUrl = Url
|
||||||
|
[ Segment $ Static "test" ]
|
||||||
|
-- Shoud this be |intX| or |listX of intX| ?
|
||||||
|
[ QueryArg ("params", "listX of intX") List ]
|
||||||
|
, _reqMethod = "PUT"
|
||||||
|
, _reqHeaders = []
|
||||||
|
, _reqBody = Just "stringX"
|
||||||
|
, _reqReturnType = "voidX"
|
||||||
|
, _funcName = ["put", "test"]
|
||||||
|
}
|
||||||
|
|
||||||
|
it "collects all info for delete request" $ do
|
||||||
|
shouldBe deleteReq $ defReq
|
||||||
|
{ _reqUrl = Url
|
||||||
|
[ Segment $ Static "test"
|
||||||
|
, Segment $ Cap ("id", "intX") ]
|
||||||
|
[]
|
||||||
|
, _reqMethod = "DELETE"
|
||||||
|
, _reqHeaders = []
|
||||||
|
, _reqBody = Nothing
|
||||||
|
, _reqReturnType = "voidX"
|
||||||
|
, _funcName = ["delete", "test", "by", "id"]
|
||||||
|
}
|
||||||
|
|
||||||
|
|
|
@ -13,7 +13,7 @@ description:
|
||||||
<https://github.com/haskell-servant/servant/blob/master/servant-js/CHANGELOG.md CHANGELOG>
|
<https://github.com/haskell-servant/servant/blob/master/servant-js/CHANGELOG.md CHANGELOG>
|
||||||
license: BSD3
|
license: BSD3
|
||||||
license-file: LICENSE
|
license-file: LICENSE
|
||||||
author: Alp Mestanogullari
|
author: Alp Mestanogullari, Maksymilian Owsianny
|
||||||
maintainer: alpmestan@gmail.com
|
maintainer: alpmestan@gmail.com
|
||||||
copyright: 2014 Alp Mestanogullari
|
copyright: 2014 Alp Mestanogullari
|
||||||
category: Web
|
category: Web
|
||||||
|
|
|
@ -2,6 +2,7 @@
|
||||||
{-# LANGUAGE FlexibleContexts #-}
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
{-# LANGUAGE FlexibleInstances #-}
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
{-# LANGUAGE TypeOperators #-}
|
{-# LANGUAGE TypeOperators #-}
|
||||||
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : Servant.JS
|
-- Module : Servant.JS
|
||||||
|
@ -109,6 +110,7 @@ module Servant.JS
|
||||||
, -- * Misc.
|
, -- * Misc.
|
||||||
listFromAPI
|
listFromAPI
|
||||||
, javascript
|
, javascript
|
||||||
|
, NoTypes
|
||||||
, GenerateList(..)
|
, GenerateList(..)
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
@ -121,46 +123,30 @@ import Servant.JS.Axios
|
||||||
import Servant.JS.Internal
|
import Servant.JS.Internal
|
||||||
import Servant.JS.JQuery
|
import Servant.JS.JQuery
|
||||||
import Servant.JS.Vanilla
|
import Servant.JS.Vanilla
|
||||||
|
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 layout => Proxy layout -> Foreign layout
|
javascript :: HasForeign NoTypes layout => Proxy layout -> Foreign layout
|
||||||
javascript p = foreignFor p defReq
|
javascript p = foreignFor (Proxy :: Proxy NoTypes) 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 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 p)
|
jsForAPI p gen = gen (listFromAPI (Proxy :: Proxy NoTypes) 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 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
|
||||||
-> IO ()
|
-> IO ()
|
||||||
writeJSForAPI p gen fp = writeFile fp (jsForAPI p gen)
|
writeJSForAPI p gen fp = writeFile fp (jsForAPI p gen)
|
||||||
|
|
||||||
-- | Utility class used by 'jsForAPI' 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 -> [AjaxReq]
|
|
||||||
|
|
||||||
instance GenerateList AjaxReq where
|
|
||||||
generateList r = [r]
|
|
||||||
|
|
||||||
instance (GenerateList start, GenerateList rest) => GenerateList (start :<|> rest) where
|
|
||||||
generateList (start :<|> rest) = (generateList start) ++ (generateList rest)
|
|
||||||
|
|
||||||
-- | Generate the necessary data for JS codegen as a list, each 'AjaxReq'
|
|
||||||
-- describing one endpoint from your API type.
|
|
||||||
listFromAPI :: (HasForeign api, GenerateList (Foreign api)) => Proxy api -> [AjaxReq]
|
|
||||||
listFromAPI p = generateList (javascript p)
|
|
||||||
|
|
||||||
|
|
|
@ -2,6 +2,7 @@
|
||||||
module Servant.JS.Angular where
|
module Servant.JS.Angular where
|
||||||
|
|
||||||
import Control.Lens
|
import Control.Lens
|
||||||
|
import Data.Maybe (isJust)
|
||||||
import Data.Monoid
|
import Data.Monoid
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
|
@ -74,9 +75,9 @@ generateAngularJSWith ngOptions opts req = "\n" <>
|
||||||
where argsStr = T.intercalate ", " args
|
where argsStr = T.intercalate ", " args
|
||||||
args = http
|
args = http
|
||||||
++ captures
|
++ captures
|
||||||
++ map (view argName) queryparams
|
++ map (view $ argName._1) queryparams
|
||||||
++ body
|
++ body
|
||||||
++ map (toValidFunctionName . (<>) "header" . headerArgName) hs
|
++ map (toValidFunctionName . (<>) "header" . fst . headerArg) hs
|
||||||
|
|
||||||
-- If we want to generate Top Level Function, they must depend on
|
-- If we want to generate Top Level Function, they must depend on
|
||||||
-- the $http service, if we generate a service, the functions will
|
-- the $http service, if we generate a service, the functions will
|
||||||
|
@ -85,7 +86,7 @@ generateAngularJSWith ngOptions opts req = "\n" <>
|
||||||
0 -> ["$http"]
|
0 -> ["$http"]
|
||||||
_ -> []
|
_ -> []
|
||||||
|
|
||||||
captures = map captureArg
|
captures = map (fst . captureArg)
|
||||||
. filter isCapture
|
. filter isCapture
|
||||||
$ req ^. reqUrl.path
|
$ req ^. reqUrl.path
|
||||||
|
|
||||||
|
@ -93,12 +94,12 @@ generateAngularJSWith ngOptions opts req = "\n" <>
|
||||||
|
|
||||||
queryparams = req ^.. reqUrl.queryStr.traverse
|
queryparams = req ^.. reqUrl.queryStr.traverse
|
||||||
|
|
||||||
body = if req ^. reqBody
|
body = if isJust (req ^. reqBody)
|
||||||
then [requestBody opts]
|
then [requestBody opts]
|
||||||
else []
|
else []
|
||||||
|
|
||||||
dataBody =
|
dataBody =
|
||||||
if req ^. reqBody
|
if isJust (req ^. reqBody)
|
||||||
then " , data: JSON.stringify(body)\n" <>
|
then " , data: JSON.stringify(body)\n" <>
|
||||||
" , contentType: 'application/json'\n"
|
" , contentType: 'application/json'\n"
|
||||||
else ""
|
else ""
|
||||||
|
@ -110,7 +111,7 @@ generateAngularJSWith ngOptions opts req = "\n" <>
|
||||||
|
|
||||||
where headersStr = T.intercalate ", " $ map headerStr hs
|
where headersStr = T.intercalate ", " $ map headerStr hs
|
||||||
headerStr header = "\"" <>
|
headerStr header = "\"" <>
|
||||||
headerArgName header <>
|
fst (headerArg header) <>
|
||||||
"\": " <> toJSHeader header
|
"\": " <> toJSHeader header
|
||||||
|
|
||||||
namespace =
|
namespace =
|
||||||
|
|
|
@ -2,6 +2,7 @@
|
||||||
module Servant.JS.Axios where
|
module Servant.JS.Axios where
|
||||||
|
|
||||||
import Control.Lens
|
import Control.Lens
|
||||||
|
import Data.Maybe (isJust)
|
||||||
import Data.Monoid
|
import Data.Monoid
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
|
@ -60,11 +61,11 @@ generateAxiosJSWith aopts opts req = "\n" <>
|
||||||
|
|
||||||
where argsStr = T.intercalate ", " args
|
where argsStr = T.intercalate ", " args
|
||||||
args = captures
|
args = captures
|
||||||
++ map (view argName) queryparams
|
++ map (view $ argName._1) queryparams
|
||||||
++ body
|
++ body
|
||||||
++ map (toValidFunctionName . (<>) "header" . headerArgName) hs
|
++ map (toValidFunctionName . (<>) "header" . fst . headerArg) hs
|
||||||
|
|
||||||
captures = map captureArg
|
captures = map (fst . captureArg)
|
||||||
. filter isCapture
|
. filter isCapture
|
||||||
$ req ^. reqUrl.path
|
$ req ^. reqUrl.path
|
||||||
|
|
||||||
|
@ -72,12 +73,12 @@ generateAxiosJSWith aopts opts req = "\n" <>
|
||||||
|
|
||||||
queryparams = req ^.. reqUrl.queryStr.traverse
|
queryparams = req ^.. reqUrl.queryStr.traverse
|
||||||
|
|
||||||
body = if req ^. reqBody
|
body = if isJust (req ^. reqBody)
|
||||||
then [requestBody opts]
|
then [requestBody opts]
|
||||||
else []
|
else []
|
||||||
|
|
||||||
dataBody =
|
dataBody =
|
||||||
if req ^. reqBody
|
if isJust (req ^. reqBody)
|
||||||
then " , data: body\n" <>
|
then " , data: body\n" <>
|
||||||
" , responseType: 'json'\n"
|
" , responseType: 'json'\n"
|
||||||
else ""
|
else ""
|
||||||
|
@ -104,7 +105,7 @@ generateAxiosJSWith aopts opts req = "\n" <>
|
||||||
|
|
||||||
where headersStr = T.intercalate ", " $ map headerStr hs
|
where headersStr = T.intercalate ", " $ map headerStr hs
|
||||||
headerStr header = "\"" <>
|
headerStr header = "\"" <>
|
||||||
headerArgName header <>
|
fst (headerArg header) <>
|
||||||
"\": " <> toJSHeader header
|
"\": " <> toJSHeader header
|
||||||
|
|
||||||
namespace =
|
namespace =
|
||||||
|
|
|
@ -18,6 +18,7 @@ module Servant.JS.Internal
|
||||||
, defReq
|
, defReq
|
||||||
, reqHeaders
|
, reqHeaders
|
||||||
, HasForeign(..)
|
, HasForeign(..)
|
||||||
|
, HasForeignType(..)
|
||||||
, HeaderArg(..)
|
, HeaderArg(..)
|
||||||
, concatCase
|
, concatCase
|
||||||
, snakeCase
|
, snakeCase
|
||||||
|
@ -31,7 +32,7 @@ module Servant.JS.Internal
|
||||||
, Header
|
, Header
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Lens ((^.))
|
import Control.Lens ((^.), _1)
|
||||||
import qualified Data.CharSet as Set
|
import qualified Data.CharSet as Set
|
||||||
import qualified Data.CharSet.Unicode.Category as Set
|
import qualified Data.CharSet.Unicode.Category as Set
|
||||||
import Data.Monoid
|
import Data.Monoid
|
||||||
|
@ -115,7 +116,7 @@ toValidFunctionName t =
|
||||||
]
|
]
|
||||||
|
|
||||||
toJSHeader :: HeaderArg -> Text
|
toJSHeader :: HeaderArg -> Text
|
||||||
toJSHeader (HeaderArg n) = toValidFunctionName ("header" <> n)
|
toJSHeader (HeaderArg n) = toValidFunctionName ("header" <> fst n)
|
||||||
toJSHeader (ReplaceHeaderArg n p)
|
toJSHeader (ReplaceHeaderArg n p)
|
||||||
| pn `T.isPrefixOf` p = pv <> " + \"" <> rp <> "\""
|
| pn `T.isPrefixOf` p = pv <> " + \"" <> rp <> "\""
|
||||||
| pn `T.isSuffixOf` p = "\"" <> rp <> "\" + " <> pv
|
| pn `T.isSuffixOf` p = "\"" <> rp <> "\" + " <> pv
|
||||||
|
@ -123,8 +124,8 @@ toJSHeader (ReplaceHeaderArg n p)
|
||||||
<> "\""
|
<> "\""
|
||||||
| otherwise = p
|
| otherwise = p
|
||||||
where
|
where
|
||||||
pv = toValidFunctionName ("header" <> n)
|
pv = toValidFunctionName ("header" <> fst n)
|
||||||
pn = "{" <> n <> "}"
|
pn = "{" <> fst n <> "}"
|
||||||
rp = T.replace pn "" p
|
rp = T.replace pn "" p
|
||||||
|
|
||||||
jsSegments :: [Segment] -> Text
|
jsSegments :: [Segment] -> Text
|
||||||
|
@ -138,7 +139,7 @@ segmentToStr (Segment st) notTheEnd =
|
||||||
|
|
||||||
segmentTypeToStr :: SegmentType -> Text
|
segmentTypeToStr :: SegmentType -> Text
|
||||||
segmentTypeToStr (Static s) = s
|
segmentTypeToStr (Static s) = s
|
||||||
segmentTypeToStr (Cap s) = "' + encodeURIComponent(" <> s <> ") + '"
|
segmentTypeToStr (Cap s) = "' + encodeURIComponent(" <> fst s <> ") + '"
|
||||||
|
|
||||||
jsGParams :: Text -> [QueryArg] -> Text
|
jsGParams :: Text -> [QueryArg] -> Text
|
||||||
jsGParams _ [] = ""
|
jsGParams _ [] = ""
|
||||||
|
@ -160,4 +161,4 @@ paramToStr qarg notTheEnd =
|
||||||
<> "[]=' + encodeURIComponent("
|
<> "[]=' + encodeURIComponent("
|
||||||
<> name
|
<> name
|
||||||
<> if notTheEnd then ") + '" else ")"
|
<> if notTheEnd then ") + '" else ")"
|
||||||
where name = qarg ^. argName
|
where name = qarg ^. argName . _1
|
||||||
|
|
|
@ -2,6 +2,7 @@
|
||||||
module Servant.JS.JQuery where
|
module Servant.JS.JQuery where
|
||||||
|
|
||||||
import Control.Lens
|
import Control.Lens
|
||||||
|
import Data.Maybe (isJust)
|
||||||
import Data.Monoid
|
import Data.Monoid
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
|
@ -40,12 +41,12 @@ generateJQueryJSWith opts req = "\n" <>
|
||||||
|
|
||||||
where argsStr = T.intercalate ", " args
|
where argsStr = T.intercalate ", " args
|
||||||
args = captures
|
args = captures
|
||||||
++ map (view argName) queryparams
|
++ map (view $ argName._1) queryparams
|
||||||
++ body
|
++ body
|
||||||
++ map (toValidFunctionName . (<>) "header" . headerArgName) hs
|
++ map (toValidFunctionName . (<>) "header" . fst . headerArg) hs
|
||||||
++ [onSuccess, onError]
|
++ [onSuccess, onError]
|
||||||
|
|
||||||
captures = map captureArg
|
captures = map (fst . captureArg)
|
||||||
. filter isCapture
|
. filter isCapture
|
||||||
$ req ^. reqUrl.path
|
$ req ^. reqUrl.path
|
||||||
|
|
||||||
|
@ -53,7 +54,7 @@ generateJQueryJSWith opts req = "\n" <>
|
||||||
|
|
||||||
queryparams = req ^.. reqUrl.queryStr.traverse
|
queryparams = req ^.. reqUrl.queryStr.traverse
|
||||||
|
|
||||||
body = if req ^. reqBody
|
body = if isJust (req ^. reqBody)
|
||||||
then [requestBody opts]
|
then [requestBody opts]
|
||||||
else []
|
else []
|
||||||
|
|
||||||
|
@ -61,7 +62,7 @@ generateJQueryJSWith opts req = "\n" <>
|
||||||
onError = errorCallback opts
|
onError = errorCallback opts
|
||||||
|
|
||||||
dataBody =
|
dataBody =
|
||||||
if req ^. reqBody
|
if isJust $ req ^. reqBody
|
||||||
then " , data: JSON.stringify(body)\n" <>
|
then " , data: JSON.stringify(body)\n" <>
|
||||||
" , contentType: 'application/json'\n"
|
" , contentType: 'application/json'\n"
|
||||||
else ""
|
else ""
|
||||||
|
@ -73,7 +74,7 @@ generateJQueryJSWith opts req = "\n" <>
|
||||||
|
|
||||||
where headersStr = T.intercalate ", " $ map headerStr hs
|
where headersStr = T.intercalate ", " $ map headerStr hs
|
||||||
headerStr header = "\"" <>
|
headerStr header = "\"" <>
|
||||||
headerArgName header <>
|
fst (headerArg header) <>
|
||||||
"\": " <> toJSHeader header
|
"\": " <> toJSHeader header
|
||||||
|
|
||||||
namespace = if (moduleName opts) == ""
|
namespace = if (moduleName opts) == ""
|
||||||
|
|
|
@ -2,6 +2,7 @@
|
||||||
module Servant.JS.Vanilla where
|
module Servant.JS.Vanilla where
|
||||||
|
|
||||||
import Control.Lens
|
import Control.Lens
|
||||||
|
import Data.Maybe (isJust)
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import Data.Monoid
|
import Data.Monoid
|
||||||
|
@ -47,12 +48,12 @@ generateVanillaJSWith opts req = "\n" <>
|
||||||
|
|
||||||
where argsStr = T.intercalate ", " args
|
where argsStr = T.intercalate ", " args
|
||||||
args = captures
|
args = captures
|
||||||
++ map (view argName) queryparams
|
++ map (view $ argName._1) queryparams
|
||||||
++ body
|
++ body
|
||||||
++ map (toValidFunctionName . (<>) "header" . headerArgName) hs
|
++ map (toValidFunctionName . (<>) "header" . fst . headerArg) hs
|
||||||
++ [onSuccess, onError]
|
++ [onSuccess, onError]
|
||||||
|
|
||||||
captures = map captureArg
|
captures = map (fst . captureArg)
|
||||||
. filter isCapture
|
. filter isCapture
|
||||||
$ req ^. reqUrl.path
|
$ req ^. reqUrl.path
|
||||||
|
|
||||||
|
@ -60,7 +61,7 @@ generateVanillaJSWith opts req = "\n" <>
|
||||||
|
|
||||||
queryparams = req ^.. reqUrl.queryStr.traverse
|
queryparams = req ^.. reqUrl.queryStr.traverse
|
||||||
|
|
||||||
body = if req ^. reqBody
|
body = if isJust(req ^. reqBody)
|
||||||
then [requestBody opts]
|
then [requestBody opts]
|
||||||
else []
|
else []
|
||||||
|
|
||||||
|
@ -68,7 +69,7 @@ generateVanillaJSWith opts req = "\n" <>
|
||||||
onError = errorCallback opts
|
onError = errorCallback opts
|
||||||
|
|
||||||
dataBody =
|
dataBody =
|
||||||
if req ^. reqBody
|
if isJust (req ^. reqBody)
|
||||||
then "JSON.stringify(body)\n"
|
then "JSON.stringify(body)\n"
|
||||||
else "null"
|
else "null"
|
||||||
|
|
||||||
|
@ -80,7 +81,7 @@ generateVanillaJSWith opts req = "\n" <>
|
||||||
|
|
||||||
where headersStr = T.intercalate "\n" $ map headerStr hs
|
where headersStr = T.intercalate "\n" $ map headerStr hs
|
||||||
headerStr header = " xhr.setRequestHeader(\"" <>
|
headerStr header = " xhr.setRequestHeader(\"" <>
|
||||||
headerArgName header <>
|
fst (headerArg header) <>
|
||||||
"\", " <> toJSHeader header <> ");"
|
"\", " <> toJSHeader header <> ");"
|
||||||
|
|
||||||
namespace = if moduleName opts == ""
|
namespace = if moduleName opts == ""
|
||||||
|
|
|
@ -98,16 +98,17 @@ 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)
|
||||||
it "should add withCredentials when needed" $ do
|
it "should add withCredentials when needed" $ do
|
||||||
let jsText = genJS withCredOpts $ listFromAPI (Proxy :: Proxy TestAPI)
|
let jsText = genJS withCredOpts $ reqList
|
||||||
output jsText
|
output jsText
|
||||||
jsText `shouldContain` "withCredentials: true"
|
jsText `shouldContain` "withCredentials: true"
|
||||||
it "should add xsrfCookieName when needed" $ do
|
it "should add xsrfCookieName when needed" $ do
|
||||||
let jsText = genJS cookieOpts $ listFromAPI (Proxy :: Proxy TestAPI)
|
let jsText = genJS cookieOpts $ reqList
|
||||||
output jsText
|
output jsText
|
||||||
jsText `shouldContain` ("xsrfCookieName: 'MyXSRFcookie'")
|
jsText `shouldContain` ("xsrfCookieName: 'MyXSRFcookie'")
|
||||||
it "should add withCredentials when needed" $ do
|
it "should add withCredentials when needed" $ do
|
||||||
let jsText = genJS headerOpts $ listFromAPI (Proxy :: Proxy TestAPI)
|
let jsText = genJS headerOpts $ reqList
|
||||||
output jsText
|
output jsText
|
||||||
jsText `shouldContain` ("xsrfHeaderName: 'MyXSRFheader'")
|
jsText `shouldContain` ("xsrfHeaderName: 'MyXSRFheader'")
|
||||||
where
|
where
|
||||||
|
@ -121,18 +122,19 @@ 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)
|
||||||
it "should implement a service globally" $ do
|
it "should implement a service globally" $ do
|
||||||
let jsText = genJS $ listFromAPI (Proxy :: Proxy TestAPI)
|
let jsText = genJS reqList
|
||||||
output jsText
|
output jsText
|
||||||
jsText `shouldContain` (".service('" <> testName <> "'")
|
jsText `shouldContain` (".service('" <> testName <> "'")
|
||||||
|
|
||||||
it "should depend on $http service globally" $ do
|
it "should depend on $http service globally" $ do
|
||||||
let jsText = genJS $ listFromAPI (Proxy :: Proxy TestAPI)
|
let jsText = genJS reqList
|
||||||
output jsText
|
output jsText
|
||||||
jsText `shouldContain` ("('" <> testName <> "', function($http) {")
|
jsText `shouldContain` ("('" <> testName <> "', function($http) {")
|
||||||
|
|
||||||
it "should not depend on $http service in handlers" $ do
|
it "should not depend on $http service in handlers" $ do
|
||||||
let jsText = genJS $ listFromAPI (Proxy :: Proxy TestAPI)
|
let jsText = genJS reqList
|
||||||
output jsText
|
output jsText
|
||||||
jsText `shouldNotContain` "getsomething($http, "
|
jsText `shouldNotContain` "getsomething($http, "
|
||||||
where
|
where
|
||||||
|
|
|
@ -6,6 +6,7 @@
|
||||||
{-# LANGUAGE TypeFamilies #-}
|
{-# LANGUAGE TypeFamilies #-}
|
||||||
{-# LANGUAGE TypeOperators #-}
|
{-# LANGUAGE TypeOperators #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||||
|
|
||||||
module Servant.JSSpec.CustomHeaders where
|
module Servant.JSSpec.CustomHeaders where
|
||||||
|
|
||||||
|
@ -21,12 +22,12 @@ 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 sublayout)
|
instance (KnownSymbol sym, HasForeign lang sublayout)
|
||||||
=> HasForeign (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 Proxy req = foreignFor (Proxy :: Proxy sublayout) $
|
foreignFor lang Proxy req = foreignFor lang (Proxy :: Proxy sublayout) $
|
||||||
req & reqHeaders <>~ [ ReplaceHeaderArg "Authorization" $
|
req & reqHeaders <>~ [ ReplaceHeaderArg ("Authorization", "") $
|
||||||
tokenType (pack . symbolVal $ (Proxy :: Proxy sym)) ]
|
tokenType (pack . symbolVal $ (Proxy :: Proxy sym)) ]
|
||||||
where
|
where
|
||||||
tokenType t = t <> " {Authorization}"
|
tokenType t = t <> " {Authorization}"
|
||||||
|
@ -34,23 +35,23 @@ instance (KnownSymbol sym, HasForeign 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 sublayout)
|
instance (HasForeign lang sublayout)
|
||||||
=> HasForeign (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 Proxy req = foreignFor (Proxy :: Proxy sublayout) $
|
foreignFor lang Proxy req = foreignFor lang (Proxy :: Proxy sublayout) $
|
||||||
req & reqHeaders <>~ [ ReplaceHeaderArg "X-MyLovelyHorse" tpl ]
|
req & reqHeaders <>~ [ ReplaceHeaderArg ("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 sublayout)
|
instance (HasForeign lang sublayout)
|
||||||
=> HasForeign (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 Proxy req = foreignFor (Proxy :: Proxy sublayout) $
|
foreignFor lang Proxy req = foreignFor lang (Proxy :: Proxy sublayout) $
|
||||||
req & reqHeaders <>~ [ ReplaceHeaderArg "X-WhatsForDinner" tpl ]
|
req & reqHeaders <>~ [ ReplaceHeaderArg ("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