no opinion on valid function names in servant-foreign

servant-foreign/servant-foreign.cabal

@@ -20,10 +20,8 @@ source-repository head
 library
   exposed-modules:     Servant.Foreign
   build-depends:       base == 4.*
-                     , charset
                      , lens >= 4
                      , servant >= 0.5
-                     , text
   hs-source-dirs:      src
   default-language:    Haskell2010
   ghc-options:         -Wall

servant-foreign/src/Servant/Foreign.hs

@@ -21,7 +21,6 @@ module Servant.Foreign
   , HeaderArg(..)
   , ArgType(..)
   , Req
-  , toValidFunctionName
   , captureArg
   , defReq
   , concatCase
@@ -48,12 +47,8 @@ import Control.Applicative
 #endif
 import Control.Lens hiding (List)
 import Data.Char (toLower, toUpper)
-import qualified Data.CharSet as Set
-import qualified Data.CharSet.Unicode.Category as Set
 import Data.List
-import Data.Monoid
 import Data.Proxy
-import qualified Data.Text as T
 import GHC.Exts (Constraint)
 import GHC.TypeLits
 import Servant.API
@@ -105,59 +100,9 @@ data HeaderArg = HeaderArg
   | ReplaceHeaderArg
     { headerArgName :: String
     , headerPattern :: String
-    } deriving (Eq)
+    } deriving (Eq, Show)
 
 
--- | 
-instance Show HeaderArg where
-  show (HeaderArg n)          = toValidFunctionName ("header" <> n)
-  show (ReplaceHeaderArg n p)
-      | pn `isPrefixOf` p = pv <> " + \"" <> rp <> "\""
-      | pn `isSuffixOf` p = "\"" <> rp <> "\" + " <> pv
-      | pn `isInfixOf` p  = "\"" <> (replace pn ("\" + " <> pv <> " + \"") p)
-                                 <> "\""
-      | otherwise         = p
-    where
-      pv = toValidFunctionName ("header" <> n)
-      pn = "{" <> n <> "}"
-      rp = replace pn "" p
-      -- Use replace method from Data.Text
-      replace old new = T.unpack .
-          T.replace (T.pack old) (T.pack new) .
-          T.pack
-
--- | Attempts to reduce the function name provided to that allowed by @'Foreign'@.
---
--- Here we are making an assumption that js identifiers are common enough.
--- https://mathiasbynens.be/notes/javascript-identifiers
--- Couldn't work out how to handle zero-width characters.
--- TODO: compare it with other generated languages(such as ruby via lackey)
--- and generalize.
--- 
--- @TODO: specify better default function name, or throw error?
-toValidFunctionName :: String -> String
-toValidFunctionName (x:xs) = [setFirstChar x] <> filter remainder xs
-  where
-    setFirstChar c = if firstChar c
-        then c
-        else '_'
-    firstChar c = prefixOK c || any (Set.member c) firstLetterOK
-    remainder c = prefixOK c || any (Set.member c) remainderOK
-    -- Valid prefixes
-    prefixOK c = c `elem` ['$','_']
-    -- Unicode character sets
-    firstLetterOK = [ Set.lowercaseLetter
-                    , Set.uppercaseLetter
-                    , Set.titlecaseLetter
-                    , Set.modifierLetter
-                    , Set.otherLetter
-                    , Set.letterNumber ]
-    remainderOK   = firstLetterOK <> [ Set.nonSpacingMark
-                                     , Set.spacingCombiningMark
-                                     , Set.decimalNumber
-                                     , Set.connectorPunctuation ]
-toValidFunctionName [] = "_"
-
 type MatrixArg = QueryArg
 
 data Url = Url

servant-js/servant-js.cabal

@@ -41,8 +41,10 @@ library
                        Servant.JS.JQuery
                        Servant.JS.Vanilla
   build-depends:       base >=4.5 && <5
+                     , charset
                      , lens >= 4
                      , servant-foreign >= 0.1
+                     , text
   hs-source-dirs:      src
   default-language:    Haskell2010
   ghc-options:         -Wall
@@ -82,4 +84,5 @@ test-suite spec
                    , lens >= 4
                    , servant
                    , servant-js
+                   , text
   default-language:  Haskell2010

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

@@ -109,7 +109,7 @@ generateAngularJSWith ngOptions opts req = "\n" <>
           where headersStr = intercalate ", " $ map headerStr hs
                 headerStr header = "\"" ++
                   headerArgName header ++
-                  "\": " ++ show header
+                  "\": " ++ toJSHeader header
 
         namespace =
             if hasService

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

@@ -104,7 +104,7 @@ generateAxiosJSWith aopts opts req = "\n" <>
           where headersStr = intercalate ", " $ map headerStr hs
                 headerStr header = "\"" ++
                   headerArgName header ++
-                  "\": " ++ show header
+                  "\": " ++ toJSHeader header
 
         namespace =
                if hasNoModule

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

@@ -10,6 +10,8 @@ module Servant.JS.Internal
   , jsGParams
   , jsMParams
   , paramToStr
+  , toValidFunctionName
+  , toJSHeader
   -- re-exports
   , (:<|>)(..)
   , (:>)
@@ -30,6 +32,11 @@ module Servant.JS.Internal
   ) where 
 
 import           Control.Lens hiding (List)
+import qualified Data.CharSet as Set
+import qualified Data.CharSet.Unicode.Category as Set
+import           Data.List
+import           Data.Monoid
+import qualified Data.Text as T
 import           Servant.Foreign
 
 type AjaxReq = Req
@@ -74,6 +81,51 @@ defCommonGeneratorOptions = CommonGeneratorOptions
   , urlPrefix = ""
   }
 
+-- | Attempts to reduce the function name provided to that allowed by @'Foreign'@.
+--
+-- https://mathiasbynens.be/notes/javascript-identifiers
+-- Couldn't work out how to handle zero-width characters.
+--
+-- @TODO: specify better default function name, or throw error?
+toValidFunctionName :: String -> String
+toValidFunctionName (x:xs) = [setFirstChar x] <> filter remainder xs
+  where
+    setFirstChar c = if firstChar c then c else '_'
+    firstChar c = prefixOK c || any (Set.member c) firstLetterOK
+    remainder c = prefixOK c || any (Set.member c) remainderOK
+    -- Valid prefixes
+    prefixOK c = c `elem` ['$','_']
+    -- Unicode character sets
+    firstLetterOK = [ Set.lowercaseLetter
+                    , Set.uppercaseLetter
+                    , Set.titlecaseLetter
+                    , Set.modifierLetter
+                    , Set.otherLetter
+                    , Set.letterNumber ]
+    remainderOK   = firstLetterOK
+               <> [ Set.nonSpacingMark
+                  , Set.spacingCombiningMark
+                  , Set.decimalNumber
+                  , Set.connectorPunctuation ]
+toValidFunctionName [] = "_"
+
+toJSHeader :: HeaderArg -> String
+toJSHeader (HeaderArg n)          = toValidFunctionName ("header" <> n)
+toJSHeader (ReplaceHeaderArg n p)
+  | pn `isPrefixOf` p = pv <> " + \"" <> rp <> "\""
+  | pn `isSuffixOf` p = "\"" <> rp <> "\" + " <> pv
+  | pn `isInfixOf` p  = "\"" <> (replace pn ("\" + " <> pv <> " + \"") p)
+                             <> "\""
+  | otherwise         = p
+  where
+    pv = toValidFunctionName ("header" <> n)
+    pn = "{" <> n <> "}"
+    rp = replace pn "" p
+    -- Use replace method from Data.Text
+    replace old new = T.unpack
+                    . T.replace (T.pack old) (T.pack new)
+                    . T.pack
+
 jsSegments :: [Segment] -> String
 jsSegments []  = ""
 jsSegments [x] = "/" ++ segmentToStr x False

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

@@ -72,7 +72,7 @@ generateJQueryJSWith opts req = "\n" <>
           where headersStr = intercalate ", " $ map headerStr hs
                 headerStr header = "\"" ++
                   headerArgName header ++
-                  "\": " ++ show header
+                  "\": " ++ toJSHeader header
 
         namespace = if null (moduleName opts)
                        then "var "

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

@@ -79,7 +79,7 @@ generateVanillaJSWith opts req = "\n" <>
           where headersStr = intercalate "\n" $ map headerStr hs
                 headerStr header = "  xhr.setRequestHeader(\"" ++
                   headerArgName header ++
-                  "\", " ++ show header ++ ");"
+                  "\", " ++ toJSHeader header ++ ");"
 
         namespace = if null (moduleName opts)
                        then "var "