[servant-foreign] Parameterise Req with a foreign type

servant-foreign/servant-foreign.cabal

@@ -46,6 +46,7 @@ library
                      , GeneralizedNewtypeDeriving
                      , MultiParamTypeClasses
                      , ScopedTypeVariables
+                     , StandaloneDeriving
                      , TemplateHaskell
                      , TypeFamilies
                      , TypeOperators
@@ -64,6 +65,7 @@ test-suite spec
   build-depends:     base
                    , hspec >= 2.1.8
                    , servant-foreign
+                   , text       >= 1.2  && < 1.3
   default-language:  Haskell2010
   default-extensions:  ConstraintKinds
                      , DataKinds

servant-foreign/src/Servant/Foreign/Internal.hs

@@ -27,8 +27,12 @@ newtype FunctionName = FunctionName { unFunctionName :: [Text] }
 
 makePrisms ''FunctionName
 
-newtype ForeignType = ForeignType { unForeignType :: Text }
+newtype ForeignType f = ForeignType { unForeignType :: f }
-  deriving (Show, Eq, IsString, Monoid)
+
+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
 
@@ -37,39 +41,45 @@ newtype PathSegment = PathSegment { unPathSegment :: Text }
 
 makePrisms ''PathSegment
 
-data Arg = Arg
+data Arg f = Arg
   { _argName :: PathSegment
-  , _argType :: ForeignType }
+  , _argType :: ForeignType f }
-  deriving (Show, Eq)
+
+deriving instance Eq f => Eq (Arg f)
+deriving instance Show f => Show (Arg f)
 
 makeLenses ''Arg
 
-argPath :: Getter Arg Text
+argPath :: Getter (Arg f) Text
 argPath = argName . _PathSegment
 
-data SegmentType
+data SegmentType f
   = Static PathSegment
     -- ^ a static path segment. like "/foo"
-  | Cap Arg
+  | Cap (Arg f)
     -- ^ a capture. like "/:userid"
-  deriving (Show, Eq)
+
+deriving instance Eq f => Eq (SegmentType f)
+deriving instance Show f => Show (SegmentType f)
 
 makePrisms ''SegmentType
 
-newtype Segment = Segment { unSegment :: SegmentType  }
+newtype Segment f = Segment { unSegment :: SegmentType f }
-  deriving (Eq, Show)
+
+deriving instance Eq f => Eq (Segment f)
+deriving instance Show f => Show (Segment f)
 
 makePrisms ''Segment
 
-isCapture :: Segment -> Bool
+isCapture :: Segment f -> Bool
 isCapture (Segment (Cap _)) = True
 isCapture                _  = False
 
-captureArg :: Segment -> Arg
+captureArg :: Segment f -> Arg f
 captureArg (Segment (Cap s)) = s
 captureArg                 _ = error "captureArg called on non capture"
 
-type Path = [Segment]
+type Path f = [Segment f]
 
 data ArgType
   = Normal
@@ -79,46 +89,58 @@ data ArgType
 
 makePrisms ''ArgType
 
-data QueryArg = QueryArg
+data QueryArg f = QueryArg
-  { _queryArgName :: Arg
+  { _queryArgName :: Arg f
   , _queryArgType :: ArgType
-  } deriving (Eq, Show)
+  }
+
+deriving instance Eq f => Eq (QueryArg f)
+deriving instance Show f => Show (QueryArg f)
 
 makeLenses ''QueryArg
 
-data HeaderArg = HeaderArg
+data HeaderArg f = HeaderArg
-  { _headerArg :: Arg }
+  { _headerArg :: Arg f }
   | ReplaceHeaderArg
-  { _headerArg     :: Arg
+  { _headerArg     :: Arg f
   , _headerPattern :: Text
-  } deriving (Eq, Show)
+  }
+
+deriving instance Eq f => Eq (HeaderArg f)
+deriving instance Show f => Show (HeaderArg f)
 
 makeLenses ''HeaderArg
 
 makePrisms ''HeaderArg
 
-data Url = Url
+data Url f = Url
-  { _path     :: Path
+  { _path     :: Path f
-  , _queryStr :: [QueryArg]
+  , _queryStr :: [QueryArg f]
-  } deriving (Eq, Show)
+  }
 
-defUrl :: Url
+deriving instance Eq f => Eq (Url f)
+deriving instance Show f => Show (Url f)
+
+defUrl :: Url f
 defUrl = Url [] []
 
 makeLenses ''Url
 
-data Req = Req
+data Req f = Req
-  { _reqUrl        :: Url
+  { _reqUrl        :: Url f
   , _reqMethod     :: HTTP.Method
-  , _reqHeaders    :: [HeaderArg]
+  , _reqHeaders    :: [HeaderArg f]
-  , _reqBody       :: Maybe ForeignType
+  , _reqBody       :: Maybe (ForeignType f)
-  , _reqReturnType :: ForeignType
+  , _reqReturnType :: ForeignType f
   , _reqFuncName   :: FunctionName
-  } deriving (Eq, Show)
+  }
+
+deriving instance Eq f => Eq (Req f)
+deriving instance Show f => Show (Req f)
 
 makeLenses ''Req
 
-defReq :: Req
+defReq :: Req Text
 defReq = Req defUrl "GET" [] Nothing (ForeignType "") (FunctionName [])
 
 -- | To be used exclusively as a "negative" return type/constraint
@@ -161,7 +183,7 @@ type family Elem (a :: *) (ls::[*]) :: Constraint where
 -- >
 --
 class HasForeignType lang a where
-  typeFor :: Proxy lang -> Proxy a -> ForeignType
+  typeFor :: Proxy lang -> Proxy a -> ForeignType Text
 
 data NoTypes
 
@@ -172,7 +194,7 @@ type HasNoForeignType = HasForeignType NoTypes
 
 class HasForeign lang (layout :: *) where
   type Foreign layout :: *
-  foreignFor :: Proxy lang -> Proxy layout -> Req -> Foreign layout
+  foreignFor :: Proxy lang -> Proxy layout -> Req Text -> Foreign layout
 
 instance (HasForeign lang a, HasForeign lang b)
   => HasForeign lang (a :<|> b) where
@@ -199,7 +221,7 @@ instance (KnownSymbol sym, HasForeignType lang ftype, HasForeign lang sublayout)
 
 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
+  type Foreign (Verb method status list a) = Req Text
 
   foreignFor lang Proxy req =
     req & reqFuncName . _FunctionName %~ (methodLC :)
@@ -264,7 +286,7 @@ instance
         , _argType = typeFor lang (Proxy :: Proxy Bool) }
 
 instance HasForeign lang Raw where
-  type Foreign Raw = HTTP.Method -> Req
+  type Foreign Raw = HTTP.Method -> Req Text
 
   foreignFor _ Proxy req method =
     req & reqFuncName . _FunctionName %~ ((toLower $ decodeUtf8 method) :)
@@ -329,9 +351,9 @@ instance HasForeign lang sublayout
 --   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]
+  generateList :: reqs -> [Req Text]
 
-instance GenerateList Req where
+instance GenerateList (Req Text) where
   generateList r = [r]
 
 instance (GenerateList start, GenerateList rest)
@@ -344,5 +366,5 @@ listFromAPI
   :: (HasForeign lang api, GenerateList (Foreign api))
   => Proxy lang
   -> Proxy api
-  -> [Req]
+  -> [Req Text]
 listFromAPI lang p = generateList (foreignFor lang p defReq)

servant-foreign/test/Servant/ForeignSpec.hs

@@ -6,6 +6,7 @@ module Servant.ForeignSpec where
 import Data.Monoid ((<>))
 import Data.Proxy
 import Servant.Foreign
+import Data.Text (Text(..))
 
 import Test.Hspec
 
@@ -47,7 +48,7 @@ type TestApi
  :<|> "test" :> QueryParams "params" Int :> ReqBody '[JSON] String :> Put '[JSON] ()
  :<|> "test" :> Capture "id" Int :> Delete '[JSON] ()
 
-testApi :: [Req]
+testApi :: [Req Text]
 testApi = listFromAPI (Proxy :: Proxy LangX) (Proxy :: Proxy TestApi)
 
 listFromAPISpec :: Spec

servant-js/src/Servant/JS/Internal.hs

@@ -57,12 +57,12 @@ import qualified Data.Text as T
 import           Data.Text (Text)
 import           Servant.Foreign
 
-type AjaxReq = Req
+type AjaxReq = Req Text
 
 -- 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
+type JavaScriptGenerator = [Req Text] -> Text
 
 -- | This structure is used by specific implementations to let you
 -- customize the output
@@ -139,7 +139,7 @@ toValidFunctionName t =
                     , Set.connectorPunctuation
                     ]
 
-toJSHeader :: HeaderArg -> Text
+toJSHeader :: HeaderArg f -> Text
 toJSHeader (HeaderArg n)
   = toValidFunctionName ("header" <> n ^. argName . _PathSegment)
 toJSHeader (ReplaceHeaderArg n p)
@@ -153,29 +153,29 @@ toJSHeader (ReplaceHeaderArg n p)
     pn = "{" <> n ^. argName . _PathSegment <> "}"
     rp = T.replace pn "" p
 
-jsSegments :: [Segment] -> Text
+jsSegments :: [Segment f] -> Text
 jsSegments []  = ""
 jsSegments [x] = "/" <> segmentToStr x False
 jsSegments (x:xs) = "/" <> segmentToStr x True <> jsSegments xs
 
-segmentToStr :: Segment -> Bool -> Text
+segmentToStr :: Segment f -> Bool -> Text
 segmentToStr (Segment st) notTheEnd =
   segmentTypeToStr st <> if notTheEnd then "" else "'"
 
-segmentTypeToStr :: SegmentType -> Text
+segmentTypeToStr :: SegmentType f -> Text
 segmentTypeToStr (Static s) = s ^. _PathSegment
 segmentTypeToStr (Cap s)    =
   "' + encodeURIComponent(" <> s ^. argName . _PathSegment <> ") + '"
 
-jsGParams :: Text -> [QueryArg] -> Text
+jsGParams :: Text -> [QueryArg f] -> Text
 jsGParams _ []     = ""
 jsGParams _ [x]    = paramToStr x False
 jsGParams s (x:xs) = paramToStr x True <> s <> jsGParams s xs
 
-jsParams :: [QueryArg] -> Text
+jsParams :: [QueryArg f] -> Text
 jsParams = jsGParams "&"
 
-paramToStr :: QueryArg -> Bool -> Text
+paramToStr :: QueryArg f -> Bool -> Text
 paramToStr qarg notTheEnd =
   case qarg ^. queryArgType of
     Normal -> name