Merge pull request #378 from haskell-servant/textly-typed

Utilize newtypes in servant-foreign

servant-foreign/servant-foreign.cabal

@@ -26,7 +26,9 @@ source-repository head
   location: http://github.com/haskell-servant/servant.git
 
 library
-  exposed-modules:     Servant.Foreign, Servant.Foreign.Internal
+  exposed-modules:     Servant.Foreign
+                     , Servant.Foreign.Internal
+                     , Servant.Foreign.Inflections
   build-depends:       base       == 4.*
                      , lens       == 4.*
                      , servant    == 0.5.*
@@ -36,6 +38,20 @@ library
   default-language:    Haskell2010
   ghc-options:         -Wall
   include-dirs: include
+  default-extensions:  CPP
+                     , ConstraintKinds
+                     , DataKinds
+                     , FlexibleContexts
+                     , FlexibleInstances
+                     , GeneralizedNewtypeDeriving
+                     , MultiParamTypeClasses
+                     , ScopedTypeVariables
+                     , TemplateHaskell
+                     , TypeFamilies
+                     , TypeOperators
+                     , UndecidableInstances
+                     , OverloadedStrings
+                     , PolyKinds
 
 
 test-suite spec
@@ -44,9 +60,20 @@ test-suite spec
   ghc-options:       -Wall
   include-dirs:      include
   main-is:           Spec.hs
-  other-modules:
+  other-modules:     Servant.ForeignSpec
-      Servant.ForeignSpec
   build-depends:     base
                    , hspec >= 2.1.8
                    , servant-foreign
   default-language:  Haskell2010
+  default-extensions:  ConstraintKinds
+                     , DataKinds
+                     , FlexibleContexts
+                     , FlexibleInstances
+                     , GeneralizedNewtypeDeriving
+                     , MultiParamTypeClasses
+                     , ScopedTypeVariables
+                     , TypeFamilies
+                     , TypeOperators
+                     , UndecidableInstances
+                     , OverloadedStrings
+                     , PolyKinds

servant-foreign/src/Servant/Foreign.hs

@@ -10,10 +10,14 @@ module Servant.Foreign
   , Url(..)
     -- aliases
   , Path
-  , ForeignType
+  , ForeignType(..)
-  , Arg
+  , Arg(..)
-  , FunctionName
+  , FunctionName(..)
+  , PathSegment(..)
     -- lenses
+  , aName
+  , aType
+  , aPath
   , reqUrl
   , reqMethod
   , reqHeaders
@@ -24,7 +28,10 @@ module Servant.Foreign
   , queryStr
   , argName
   , argType
+  , headerArg
     -- prisms
+  , _PathSegment
+  , _ForeignType
   , _HeaderArg
   , _ReplaceHeaderArg
   , _Static
@@ -40,14 +47,13 @@ module Servant.Foreign
   , NoTypes
   , captureArg
   , isCapture
-  , concatCase
-  , snakeCase
-  , camelCase
   , defReq
   , listFromAPI
-  -- re-exports
+    -- re-exports
   , module Servant.API
+  , module Servant.Foreign.Inflections
   ) where
 
 import Servant.API
 import Servant.Foreign.Internal
+import Servant.Foreign.Inflections

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

@@ -0,0 +1,45 @@
+module Servant.Foreign.Inflections
+  ( concatCase
+  , snakeCase
+  , camelCase
+    -- lenses
+  , concatCaseL
+  , snakeCaseL
+  , camelCaseL
+  ) where
+
+
+import           Control.Lens hiding (cons)
+import qualified Data.Char as C
+import           Data.Monoid
+import           Data.Text hiding (map)
+import           Prelude hiding (head, tail)
+import           Servant.Foreign.Internal
+
+concatCaseL :: Getter FunctionName Text
+concatCaseL = _FunctionName . to mconcat
+
+-- | Function name builder that simply concat each part together
+concatCase :: FunctionName -> Text
+concatCase = view concatCaseL
+
+snakeCaseL :: Getter FunctionName Text
+snakeCaseL = _FunctionName . to (intercalate "_")
+
+-- | Function name builder using the snake_case convention.
+-- each part is separated by a single underscore character.
+snakeCase :: FunctionName -> Text
+snakeCase = view snakeCaseL
+
+camelCaseL :: Getter FunctionName Text
+camelCaseL = _FunctionName . to (convert . map (replace "-" ""))
+  where
+    convert []     = ""
+    convert (p:ps) = mconcat $ p : map capitalize ps
+    capitalize ""   = ""
+    capitalize name = C.toUpper (head name) `cons` tail name
+
+-- | Function name builder using the CamelCase convention.
+-- each part begins with an upper case character.
+camelCase :: FunctionName -> Text
+camelCase = view camelCaseL

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

@@ -1,27 +1,18 @@
-{-# LANGUAGE CPP                   #-}
+{-# LANGUAGE CPP #-}
-{-# LANGUAGE ConstraintKinds       #-}
-{-# LANGUAGE DataKinds             #-}
-{-# LANGUAGE FlexibleContexts      #-}
-{-# LANGUAGE FlexibleInstances     #-}
 #if !MIN_VERSION_base(4,8,0)
-{-# LANGUAGE NullaryTypeClasses    #-}
+{-# LANGUAGE NullaryTypeClasses #-}
 #endif
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE ScopedTypeVariables   #-}
-{-# LANGUAGE TemplateHaskell       #-}
-{-# LANGUAGE TypeFamilies          #-}
-{-# LANGUAGE TypeOperators         #-}
-{-# LANGUAGE UndecidableInstances  #-}
-{-# LANGUAGE OverloadedStrings     #-}
-{-# LANGUAGE PolyKinds             #-}
 
 -- | Generalizes all the data needed to make code generation work with
 -- arbitrary programming languages.
 module Servant.Foreign.Internal where
 
-import           Control.Lens (makeLenses, makePrisms, (%~), (&), (.~), (<>~))
+import           Control.Lens hiding (cons, List)
-import qualified Data.Char as C
+#if !MIN_VERSION_base(4,8,0)
+import           Data.Monoid
+#endif
 import           Data.Proxy
+import           Data.String
 import           Data.Text
 import           Data.Text.Encoding (decodeUtf8)
 import           GHC.Exts (Constraint)
@@ -30,36 +21,38 @@ import qualified Network.HTTP.Types as HTTP
 import           Prelude hiding (concat)
 import           Servant.API
 
-type FunctionName = [Text]
 
--- | Function name builder that simply concat each part together
+newtype FunctionName = FunctionName { unFunctionName :: [Text] }
-concatCase :: FunctionName -> Text
+  deriving (Show, Eq, Monoid)
-concatCase = concat
 
--- | Function name builder using the snake_case convention.
+makePrisms ''FunctionName
--- each part is separated by a single underscore character.
-snakeCase :: FunctionName -> Text
-snakeCase = intercalate "_"
 
--- | Function name builder using the CamelCase convention.
+newtype ForeignType = ForeignType { unForeignType :: Text }
--- each part begins with an upper case character.
+  deriving (Show, Eq, IsString, Monoid)
-camelCase :: FunctionName -> Text
-camelCase = camelCase' . Prelude.map (replace "-" "")
-  where camelCase' []     = ""
-        camelCase' (p:ps) = concat $ p : Prelude.map capitalize ps
-        capitalize ""   = ""
-        capitalize name = C.toUpper (Data.Text.head name) `cons` Data.Text.tail name
 
-type ForeignType = Text
+makePrisms ''ForeignType
 
-type Arg = (Text, ForeignType)
+newtype PathSegment = PathSegment { unPathSegment :: Text }
+  deriving (Show, Eq, IsString, Monoid)
+
+makePrisms ''PathSegment
+
+data Arg = Arg
+  { _aName :: PathSegment
+  , _aType :: ForeignType }
+  deriving (Show, Eq)
+
+makeLenses ''Arg
+
+aPath :: Getter Arg Text
+aPath = aName . _PathSegment
 
 data SegmentType
-  = Static Text
+  = Static PathSegment
     -- ^ a static path segment. like "/foo"
   | Cap Arg
     -- ^ a capture. like "/:userid"
-  deriving (Eq, Show)
+  deriving (Show, Eq)
 
 makePrisms ''SegmentType
 
@@ -68,6 +61,14 @@ newtype Segment = Segment { unSegment :: SegmentType  }
 
 makePrisms ''Segment
 
+isCapture :: Segment -> Bool
+isCapture (Segment (Cap _)) = True
+isCapture                _  = False
+
+captureArg :: Segment -> Arg
+captureArg (Segment (Cap s)) = s
+captureArg                 _ = error "captureArg called on non capture"
+
 type Path = [Segment]
 
 data ArgType
@@ -86,10 +87,10 @@ data QueryArg = QueryArg
 makeLenses ''QueryArg
 
 data HeaderArg = HeaderArg
-  { headerArg :: Arg }
+  { _headerArg :: Arg }
   | ReplaceHeaderArg
-  { headerArg :: Arg
+  { _headerArg     :: Arg
-  , headerPattern :: Text
+  , _headerPattern :: Text
   } deriving (Eq, Show)
 
 makeLenses ''HeaderArg
@@ -117,16 +118,8 @@ data Req = Req
 
 makeLenses ''Req
 
-isCapture :: Segment -> Bool
-isCapture (Segment (Cap _)) = True
-isCapture                _  = False
-
-captureArg :: Segment -> Arg
-captureArg (Segment (Cap s)) = s
-captureArg                 _ = error "captureArg called on non capture"
-
 defReq :: Req
-defReq = Req defUrl "GET" [] Nothing "" []
+defReq = Req defUrl "GET" [] Nothing (ForeignType "") (FunctionName [])
 
 -- | To be used exclusively as a "negative" return type/constraint
 -- by @'Elem`@ type family.
@@ -173,7 +166,7 @@ class HasForeignType lang a where
 data NoTypes
 
 instance HasForeignType NoTypes ftype where
-  typeFor _ _ = empty
+  typeFor _ _ = ForeignType empty
 
 type HasNoForeignType = HasForeignType NoTypes
 
@@ -195,18 +188,21 @@ instance (KnownSymbol sym, HasForeignType lang ftype, HasForeign lang sublayout)
 
   foreignFor lang Proxy req =
     foreignFor lang (Proxy :: Proxy sublayout) $
-      req & reqUrl.path <>~ [Segment (Cap arg)]
+      req & reqUrl . path <>~ [Segment (Cap arg)]
-          & reqFuncName %~ (++ ["by", str])
+          & reqFuncName . _FunctionName %~ (++ ["by", str])
     where
-      str = pack . symbolVal $ (Proxy :: Proxy sym)
+      str   = pack . symbolVal $ (Proxy :: Proxy sym)
-      arg = (str, typeFor lang (Proxy :: Proxy ftype))
+      ftype = typeFor lang (Proxy :: Proxy ftype)
+      arg   = Arg
+        { _aName = PathSegment str
+        , _aType = ftype }
 
 instance (Elem JSON list, HasForeignType lang a, ReflectMethod method)
   => HasForeign lang (Verb method status list a) where
   type Foreign (Verb method status list a) = Req
 
   foreignFor lang Proxy req =
-    req & reqFuncName  %~ (methodLC :)
+    req & reqFuncName . _FunctionName %~ (methodLC :)
         & reqMethod .~ method
         & reqReturnType .~ retType
     where
@@ -219,12 +215,13 @@ instance (KnownSymbol sym, HasForeignType lang a, HasForeign lang sublayout)
   type Foreign (Header sym a :> sublayout) = Foreign sublayout
 
   foreignFor lang Proxy req =
-    foreignFor lang subP $ req
+    foreignFor lang subP $ req & reqHeaders <>~ [HeaderArg arg]
-        & reqHeaders <>~ [HeaderArg arg]
     where
       hname = pack . symbolVal $ (Proxy :: Proxy sym)
-      arg = (hname, typeFor lang (Proxy :: Proxy a))
+      arg   = Arg
-      subP = Proxy :: Proxy sublayout
+        { _aName = PathSegment hname
+        , _aType  = typeFor lang (Proxy :: Proxy a) }
+      subP  = Proxy :: Proxy sublayout
 
 instance (KnownSymbol sym, HasForeignType lang a, HasForeign lang sublayout)
   => HasForeign lang (QueryParam sym a :> sublayout) where
@@ -233,10 +230,11 @@ instance (KnownSymbol sym, HasForeignType lang a, HasForeign lang sublayout)
   foreignFor lang Proxy req =
     foreignFor lang (Proxy :: Proxy sublayout) $
       req & reqUrl.queryStr <>~ [QueryArg arg Normal]
-
     where
       str = pack . symbolVal $ (Proxy :: Proxy sym)
-      arg = (str, typeFor lang (Proxy :: Proxy a))
+      arg = Arg
+        { _aName = PathSegment str
+        , _aType = typeFor lang (Proxy :: Proxy a) }
 
 instance
   (KnownSymbol sym, HasForeignType lang [a], HasForeign lang sublayout)
@@ -247,7 +245,9 @@ instance
       req & reqUrl.queryStr <>~ [QueryArg arg List]
     where
       str = pack . symbolVal $ (Proxy :: Proxy sym)
-      arg = (str, typeFor lang (Proxy :: Proxy [a]))
+      arg = Arg
+        { _aName = PathSegment str
+        , _aType = typeFor lang (Proxy :: Proxy [a]) }
 
 instance
   (KnownSymbol sym, HasForeignType lang Bool, HasForeign lang sublayout)
@@ -259,13 +259,15 @@ instance
       req & reqUrl.queryStr <>~ [QueryArg arg Flag]
     where
       str = pack . symbolVal $ (Proxy :: Proxy sym)
-      arg = (str, typeFor lang (Proxy :: Proxy Bool))
+      arg = Arg
+        { _aName = PathSegment str
+        , _aType = typeFor lang (Proxy :: Proxy Bool) }
 
 instance HasForeign lang Raw where
   type Foreign Raw = HTTP.Method -> Req
 
   foreignFor _ Proxy req method =
-    req & reqFuncName %~ ((toLower $ decodeUtf8 method) :)
+    req & reqFuncName . _FunctionName %~ ((toLower $ decodeUtf8 method) :)
         & reqMethod .~ method
 
 instance (Elem JSON list, HasForeignType lang a, HasForeign lang sublayout)
@@ -282,8 +284,8 @@ instance (KnownSymbol path, HasForeign lang sublayout)
 
   foreignFor lang Proxy req =
     foreignFor lang (Proxy :: Proxy sublayout) $
-      req & reqUrl.path <>~ [Segment (Static str)]
+      req & reqUrl . path <>~ [Segment (Static (PathSegment str))]
-          & reqFuncName %~ (++ [str])
+          & reqFuncName . _FunctionName %~ (++ [str])
     where
       str =
         Data.Text.map (\c -> if c == '.' then '_' else c)

servant-foreign/test/Servant/ForeignSpec.hs

@@ -1,13 +1,4 @@
-{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE CPP               #-}
-{-# LANGUAGE TypeOperators         #-}
-{-# LANGUAGE DataKinds             #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE FlexibleContexts      #-}
-{-# LANGUAGE FlexibleInstances     #-}
-{-# LANGUAGE TypeSynonymInstances  #-}
-{-# LANGUAGE ScopedTypeVariables   #-}
-{-# LANGUAGE CPP                   #-}
-
 #include "overlapping-compat.h"
 
 module Servant.ForeignSpec where
@@ -26,15 +17,17 @@ spec = describe "Servant.Foreign" $ do
 camelCaseSpec :: Spec
 camelCaseSpec = describe "camelCase" $ do
   it "converts FunctionNames to camelCase" $ do
-    camelCase ["post", "counter", "inc"] `shouldBe` "postCounterInc"
+    camelCase (FunctionName ["post", "counter", "inc"])
-    camelCase ["get", "hyphen-ated", "counter"] `shouldBe` "getHyphenatedCounter"
+      `shouldBe` "postCounterInc"
+    camelCase (FunctionName ["get", "hyphen-ated", "counter"])
+      `shouldBe` "getHyphenatedCounter"
 
 ----------------------------------------------------------------------
 
 data LangX
 
 instance HasForeignType LangX () where
-  typeFor _ _ = "voidX"
+  typeFor _ _ = ForeignType "voidX"
 
 instance HasForeignType LangX Int where
   typeFor _ _ = "intX"
@@ -68,24 +61,24 @@ listFromAPISpec = describe "listFromAPI" $ do
     shouldBe getReq $ defReq
       { _reqUrl        = Url
           [ Segment $ Static "test" ]
-          [ QueryArg ("flag", "boolX") Flag ]
+          [ QueryArg (Arg "flag" "boolX") Flag ]
       , _reqMethod     = "GET"
-      , _reqHeaders    = [HeaderArg ("header", "listX of stringX")]
+      , _reqHeaders    = [HeaderArg $ Arg "header" "listX of stringX"]
       , _reqBody       = Nothing
       , _reqReturnType = "intX"
-      , _reqFuncName      = ["get", "test"]
+      , _reqFuncName   = FunctionName ["get", "test"]
       }
 
   it "collects all info for post request" $ do
     shouldBe postReq $ defReq
       { _reqUrl        = Url
           [ Segment $ Static "test" ]
-          [ QueryArg ("param", "intX") Normal ]
+          [ QueryArg (Arg "param" "intX") Normal ]
       , _reqMethod     = "POST"
       , _reqHeaders    = []
       , _reqBody       = Just "listX of stringX"
       , _reqReturnType = "voidX"
-      , _reqFuncName      = ["post", "test"]
+      , _reqFuncName   = FunctionName ["post", "test"]
       }
 
   it "collects all info for put request" $ do
@@ -93,23 +86,23 @@ listFromAPISpec = describe "listFromAPI" $ do
       { _reqUrl        = Url
           [ Segment $ Static "test" ]
           -- Shoud this be |intX| or |listX of intX| ?
-          [ QueryArg ("params", "listX of intX") List ]
+          [ QueryArg (Arg "params" "listX of intX") List ]
       , _reqMethod     = "PUT"
       , _reqHeaders    = []
       , _reqBody       = Just "stringX"
       , _reqReturnType = "voidX"
-      , _reqFuncName      = ["put", "test"]
+      , _reqFuncName   = FunctionName ["put", "test"]
       }
 
   it "collects all info for delete request" $ do
     shouldBe deleteReq $ defReq
       { _reqUrl        = Url
           [ Segment $ Static "test"
-          , Segment $ Cap ("id", "intX") ]
+          , Segment $ Cap (Arg "id" "intX") ]
           []
       , _reqMethod     = "DELETE"
       , _reqHeaders    = []
       , _reqBody       = Nothing
       , _reqReturnType = "voidX"
-      , _reqFuncName      = ["delete", "test", "by", "id"]
+      , _reqFuncName   = FunctionName ["delete", "test", "by", "id"]
       }

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

@@ -76,9 +76,12 @@ generateAngularJSWith ngOptions opts req = "\n" <>
   where argsStr = T.intercalate ", " args
         args = http
             ++ captures
-            ++ map (view $ argName._1) queryparams
+            ++ map (view $ argName . aPath) queryparams
             ++ body
-            ++ map (toValidFunctionName . (<>) "header" . fst . headerArg) hs
+            ++ map ( toValidFunctionName
+                   . (<>) "header"
+                   . view (headerArg . aPath)
+                   ) hs
 
         -- If we want to generate Top Level Function, they must depend on
         -- the $http service, if we generate a service, the functions will
@@ -87,9 +90,9 @@ generateAngularJSWith ngOptions opts req = "\n" <>
                   0 -> ["$http"]
                   _ -> []
 
-        captures = map (fst . captureArg)
+        captures = map (view aPath . captureArg)
                  . filter isCapture
-                 $ req ^. reqUrl.path
+                 $ req ^. reqUrl . path
 
         hs = req ^. reqHeaders
 
@@ -110,10 +113,11 @@ generateAngularJSWith ngOptions opts req = "\n" <>
             then ""
             else "    , headers: { " <> headersStr <> " }\n"
 
-          where headersStr = T.intercalate ", " $ map headerStr hs
+          where
-                headerStr header = "\"" <>
+            headersStr = T.intercalate ", " $ map headerStr hs
-                  fst (headerArg header) <>
+            headerStr header = "\"" <>
-                  "\": " <> toJSHeader header
+              header ^. headerArg . aPath <>
+              "\": " <> toJSHeader header
 
         namespace =
             if hasService

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

@@ -62,11 +62,14 @@ generateAxiosJSWith aopts opts req = "\n" <>
 
   where argsStr = T.intercalate ", " args
         args = captures
-            ++ map (view $ argName._1) queryparams
+            ++ map (view $ argName . aPath) queryparams
             ++ body
-            ++ map (toValidFunctionName . (<>) "header" . fst . headerArg) hs
+            ++ map ( toValidFunctionName
+                   . (<>) "header"
+                   . view (headerArg . aPath)
+                   ) hs
 
-        captures = map (fst . captureArg)
+        captures = map (view aPath . captureArg)
                  . filter isCapture
                  $ req ^. reqUrl.path
 
@@ -104,10 +107,11 @@ generateAxiosJSWith aopts opts req = "\n" <>
             then ""
             else "    , headers: { " <> headersStr <> " }\n"
 
-          where headersStr = T.intercalate ", " $ map headerStr hs
+          where
-                headerStr header = "\"" <>
+            headersStr = T.intercalate ", " $ map headerStr hs
-                  fst (headerArg header) <>
+            headerStr header = "\"" <>
-                  "\": " <> toJSHeader header
+              header ^. headerArg . aPath <>
+              "\": " <> toJSHeader header
 
         namespace =
                if hasNoModule

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

@@ -1,4 +1,6 @@
-{-#LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ViewPatterns #-}
+
 module Servant.JS.Internal
   ( JavaScriptGenerator
   , CommonGeneratorOptions(..)
@@ -19,7 +21,22 @@ module Servant.JS.Internal
   , reqHeaders
   , HasForeign(..)
   , HasForeignType(..)
+  , HasNoForeignType
+  , GenerateList(..)
+  , NoTypes
+  , HeaderArg
+  , ArgType(..)
   , HeaderArg(..)
+  , QueryArg(..)
+  , Req(..)
+  , Segment(..)
+  , SegmentType(..)
+  , Url(..)
+  , Path
+  , ForeignType(..)
+  , Arg(..)
+  , FunctionName(..)
+  , PathSegment(..)
   , concatCase
   , snakeCase
   , camelCase
@@ -32,7 +49,7 @@ module Servant.JS.Internal
   , Header
   ) where
 
-import           Control.Lens                  ((^.), _1)
+import           Control.Lens hiding (List)
 import qualified Data.CharSet as Set
 import qualified Data.CharSet.Unicode.Category as Set
 import           Data.Monoid
@@ -123,7 +140,8 @@ toValidFunctionName t =
                     ]
 
 toJSHeader :: HeaderArg -> Text
-toJSHeader (HeaderArg n)          = toValidFunctionName ("header" <> fst n)
+toJSHeader (HeaderArg n)
+  = toValidFunctionName ("header" <> n ^. aName . _PathSegment)
 toJSHeader (ReplaceHeaderArg n p)
   | pn `T.isPrefixOf` p = pv <> " + \"" <> rp <> "\""
   | pn `T.isSuffixOf` p = "\"" <> rp <> "\" + " <> pv
@@ -131,8 +149,8 @@ toJSHeader (ReplaceHeaderArg n p)
                              <> "\""
   | otherwise         = p
   where
-    pv = toValidFunctionName ("header" <> fst n)
+    pv = toValidFunctionName ("header" <> n ^. aName . _PathSegment)
-    pn = "{" <> fst n <> "}"
+    pn = "{" <> n ^. aName . _PathSegment <> "}"
     rp = T.replace pn "" p
 
 jsSegments :: [Segment] -> Text
@@ -145,8 +163,9 @@ segmentToStr (Segment st) notTheEnd =
   segmentTypeToStr st <> if notTheEnd then "" else "'"
 
 segmentTypeToStr :: SegmentType -> Text
-segmentTypeToStr (Static s) = s
+segmentTypeToStr (Static s) = s ^. _PathSegment
-segmentTypeToStr (Cap s)    = "' + encodeURIComponent(" <> fst s <> ") + '"
+segmentTypeToStr (Cap s)    =
+  "' + encodeURIComponent(" <> s ^. aName . _PathSegment <> ") + '"
 
 jsGParams :: Text -> [QueryArg] -> Text
 jsGParams _ []     = ""
@@ -168,4 +187,4 @@ paramToStr qarg notTheEnd =
            <> "[]=' + encodeURIComponent("
            <> name
            <> if notTheEnd then ") + '" else ")"
-  where name = qarg ^. argName . _1
+  where name = qarg ^. argName . aName . _PathSegment

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

@@ -10,6 +10,7 @@ import           Data.Text.Encoding (decodeUtf8)
 import           Servant.Foreign
 import           Servant.JS.Internal
 
+
 -- | Generate javascript functions that use the /jQuery/ library
 --   to make the AJAX calls. Uses 'defCommonGeneratorOptions'
 --   for the generator options.
@@ -42,12 +43,15 @@ generateJQueryJSWith opts req = "\n" <>
 
   where argsStr = T.intercalate ", " args
         args = captures
-            ++ map (view $ argName._1) queryparams
+            ++ map (view $ argName . aPath) queryparams
             ++ body
-            ++ map (toValidFunctionName . (<>) "header" . fst . headerArg) hs
+            ++ map (toValidFunctionName
+                   . (<>) "header"
+                   . view (headerArg . aPath)
+                   ) hs
             ++ [onSuccess, onError]
 
-        captures = map (fst . captureArg)
+        captures = map (view aPath . captureArg)
                  . filter isCapture
                  $ req ^. reqUrl.path
 
@@ -73,10 +77,11 @@ generateJQueryJSWith opts req = "\n" <>
             then ""
             else "    , headers: { " <> headersStr <> " }\n"
 
-          where headersStr = T.intercalate ", " $ map headerStr hs
+          where
-                headerStr header = "\"" <>
+            headersStr = T.intercalate ", " $ map headerStr hs
-                  fst (headerArg header) <>
+            headerStr header = "\"" <>
-                  "\": " <> toJSHeader header
+              header ^. headerArg . aPath <>
+              "\": " <> toJSHeader header
 
         namespace = if (moduleName opts) == ""
                        then "var "

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

@@ -54,12 +54,15 @@ generateVanillaJSWith opts req = "\n" <>
 
   where argsStr = T.intercalate ", " args
         args = captures
-            ++ map (view $ argName._1) queryparams
+            ++ map (view $ argName . aPath) queryparams
             ++ body
-            ++ map (toValidFunctionName . (<>) "header" . fst . headerArg) hs
+            ++ map ( toValidFunctionName
+                   . (<>) "header"
+                   . view (headerArg . aPath)
+                   ) hs
             ++ [onSuccess, onError]
 
-        captures = map (fst . captureArg)
+        captures = map (view aPath . captureArg)
                  . filter isCapture
                  $ req ^. reqUrl.path
 
@@ -85,10 +88,11 @@ generateVanillaJSWith opts req = "\n" <>
             then ""
             else headersStr <> "\n"
 
-          where headersStr = T.intercalate "\n" $ map headerStr hs
+          where
-                headerStr header = "  xhr.setRequestHeader(\"" <>
+            headersStr = T.intercalate "\n" $ map headerStr hs
-                  fst (headerArg header) <>
+            headerStr header = "  xhr.setRequestHeader(\"" <>
-                  "\", " <> toJSHeader header <> ");"
+              header ^. headerArg . aPath <>
+              "\", " <> toJSHeader header <> ");"
 
         namespace = if moduleName opts == ""
                        then "var "

servant-js/test/Servant/JSSpec/CustomHeaders.hs

@@ -27,8 +27,9 @@ instance (KnownSymbol sym, HasForeign lang sublayout)
     type Foreign (Authorization sym a :> sublayout) = Foreign sublayout
 
     foreignFor lang Proxy req = foreignFor lang (Proxy :: Proxy sublayout) $
-        req & reqHeaders <>~ [ ReplaceHeaderArg ("Authorization", "") $
+        req & reqHeaders <>~
-                               tokenType (pack . symbolVal $ (Proxy :: Proxy sym)) ]
+          [ ReplaceHeaderArg (Arg "Authorization" "")
+          $ tokenType (pack . symbolVal $ (Proxy :: Proxy sym)) ]
       where
         tokenType t = t <> " {Authorization}"
 
@@ -40,7 +41,7 @@ instance (HasForeign lang sublayout)
     type Foreign (MyLovelyHorse a :> sublayout) = Foreign sublayout
 
     foreignFor lang Proxy req = foreignFor lang (Proxy :: Proxy sublayout) $
-        req & reqHeaders <>~ [ ReplaceHeaderArg ("X-MyLovelyHorse", "") tpl ]
+        req & reqHeaders <>~ [ ReplaceHeaderArg (Arg "X-MyLovelyHorse" "") tpl ]
       where
         tpl = "I am good friends with {X-MyLovelyHorse}"
 
@@ -52,6 +53,6 @@ instance (HasForeign lang sublayout)
     type Foreign (WhatsForDinner a :> sublayout) = Foreign sublayout
 
     foreignFor lang Proxy req = foreignFor lang (Proxy :: Proxy sublayout) $
-        req & reqHeaders <>~ [ ReplaceHeaderArg ("X-WhatsForDinner", "") tpl ]
+        req & reqHeaders <>~ [ ReplaceHeaderArg (Arg "X-WhatsForDinner" "") tpl ]
       where
         tpl = "I would like {X-WhatsForDinner} with a cherry on top."