Check for illegal characters when formatting names

CHANGELOG.md

@@ -1,5 +1,11 @@
 # Change log
 
+## (unreleased)
+
+* [#35](https://github.com/codedownio/aeson-typescript/pull/35)
+    * Add `Data.Aeson.TypeScript.LegalName` module for checking whether a name is a legal JavaScript name or not.
+    * The `defaultFormatter` will `error` if the name contains illegal characters.
+
 ## 0.4.2.0
 
 * Fix TypeScript (A.KeyMap a) instance

aeson-typescript.cabal

@@ -36,6 +36,7 @@ library
       Data.Aeson.TypeScript.TH
       Data.Aeson.TypeScript.Internal
       Data.Aeson.TypeScript.Recursive
+      Data.Aeson.TypeScript.LegalName
   other-modules:
       Data.Aeson.TypeScript.Formatting
       Data.Aeson.TypeScript.Instances
@@ -66,6 +67,7 @@ test-suite aeson-typescript-tests
   other-modules:
       Basic
       ClosedTypeFamilies
+      Data.Aeson.TypeScript.LegalNameSpec
       Formatting
       Generic
       HigherKind
@@ -87,6 +89,7 @@ test-suite aeson-typescript-tests
       Data.Aeson.TypeScript.Formatting
       Data.Aeson.TypeScript.Instances
       Data.Aeson.TypeScript.Internal
+      Data.Aeson.TypeScript.LegalName
       Data.Aeson.TypeScript.Lookup
       Data.Aeson.TypeScript.Recursive
       Data.Aeson.TypeScript.TH

package.yaml

@@ -43,6 +43,7 @@ library:
     - Data.Aeson.TypeScript.TH
     - Data.Aeson.TypeScript.Internal
     - Data.Aeson.TypeScript.Recursive
+    - Data.Aeson.TypeScript.LegalName
 
 tests:
   aeson-typescript-tests:

src/Data/Aeson/TypeScript/LegalName.hs

@@ -0,0 +1,58 @@
+-- | This module defines functions which are useful for determing if
+-- a given name is a legal JavaScript name accord to <https://stackoverflow.com/questions/1661197/what-characters-are-valid-for-javascript-variable-names this post>.
+module Data.Aeson.TypeScript.LegalName where
+
+import qualified Data.Set as Set
+import Language.Haskell.TH
+import Data.List.NonEmpty (NonEmpty (..))
+import qualified Data.List.NonEmpty as NonEmpty
+import Data.Char
+import Data.Foldable
+
+
+-- | This reports a compile-time error if the given 'Name' contains
+-- characters that are not allowed in a JavaScript name.
+checkIllegalName :: Name -> Q ()
+checkIllegalName =
+  checkIllegalNameString . nameBase
+
+-- | As 'checkIllegalName', but operates on the underlying 'String'.
+checkIllegalNameString :: String -> Q ()
+checkIllegalNameString nameStr =
+  case NonEmpty.nonEmpty nameStr of
+    Just nameChars ->
+      traverse_ (traverse_ (reportError . message)) . checkIllegalNameChars $ nameChars
+    Nothing ->
+      reportError "checkIllegalName called with an empty name somehow??"
+  where
+    message c =
+      concat ["The name ", nameStr, " has an illegal character: ", show c]
+
+-- | The return type is the illegal characters that are in the name. If the
+-- input has no illegal characters, then you have 'Nothing'.
+checkIllegalNameChars :: NonEmpty Char -> Maybe (NonEmpty Char)
+checkIllegalNameChars (firstChar :| restChars) = NonEmpty.nonEmpty $
+  let
+    legalFirstCategories =
+      Set.fromList
+        [ UppercaseLetter
+        , LowercaseLetter
+        , TitlecaseLetter
+        , ModifierLetter
+        , OtherLetter
+        , LetterNumber
+        ]
+    legalRestCategories =
+      Set.fromList
+        [ NonSpacingMark
+        , SpacingCombiningMark
+        , DecimalNumber
+        , ConnectorPunctuation
+        ]
+        `Set.union` legalFirstCategories
+    isIllegalFirstChar c = not $
+      c `elem` ['$', '_'] || generalCategory c `Set.member` legalFirstCategories
+    isIllegalRestChar c = not $
+      generalCategory c `Set.member` legalRestCategories
+  in
+    filter isIllegalFirstChar [firstChar] <> filter isIllegalRestChar restChars

src/Data/Aeson/TypeScript/Types.hs

@@ -9,11 +9,13 @@
 
 module Data.Aeson.TypeScript.Types where
 
+import qualified Data.List.NonEmpty as NonEmpty
 import qualified Data.Aeson as A
 import Data.Proxy
 import Data.String
 import Data.Typeable
 import Language.Haskell.TH
+import Data.Aeson.TypeScript.LegalName
 
 -- | The typeclass that defines how a type is turned into TypeScript.
 --
@@ -131,12 +133,30 @@ data SumTypeFormat =
 defaultFormattingOptions :: FormattingOptions
 defaultFormattingOptions = FormattingOptions
   { numIndentSpaces = 2
-  , interfaceNameModifier = id
-  , typeNameModifier = id
+  , interfaceNameModifier = defaultNameFormatter
+  , typeNameModifier = defaultNameFormatter
   , exportMode = ExportNone
   , typeAlternativesFormat = TypeAlias
   }
 
+-- | The 'defaultNameFormatter' in the 'FormattingOptions' checks to see if
+-- the name is a legal TypeScript name. If it is not, then it throws
+-- a runtime error.
+defaultNameFormatter :: String -> String
+defaultNameFormatter str =
+  case NonEmpty.nonEmpty str of
+    Nothing ->
+      error "Name cannot be empty"
+    Just nameChars ->
+      case checkIllegalNameChars nameChars of
+        Just badChars ->
+          error $ concat
+            [ "The name ", str, " contains illegal characters: ", NonEmpty.toList badChars
+            , "\nConsider setting a default name formatter that replaces these characters, or renaming the type."
+            ]
+        Nothing ->
+          str
+
 -- | Convenience typeclass class you can use to "attach" a set of Aeson encoding options to a type.
 class HasJSONOptions a where
   getJSONOptions :: (Proxy a) -> A.Options

test/Data/Aeson/TypeScript/LegalNameSpec.hs

@@ -0,0 +1,23 @@
+module Data.Aeson.TypeScript.LegalNameSpec where
+
+import Test.Hspec
+import Data.List.NonEmpty (NonEmpty (..))
+import Data.Aeson.TypeScript.LegalName
+
+tests :: Spec
+tests = describe "Data.Aeson.TypeScript.LegalName" $ do
+  describe "checkIllegalNameChars" $ do
+    describe "legal Haskell names" $ do
+      it "allows an uppercase letter" $ do
+        checkIllegalNameChars ('A' :| [])
+          `shouldBe` Nothing
+      it "allows an underscore" $ do
+        checkIllegalNameChars ('_' :| "asdf")
+          `shouldBe` Nothing
+      it "reports that ' is illegal" $ do
+        checkIllegalNameChars ('F' :| "oo'")
+          `shouldBe` Just ('\'' :| [])
+    describe "illegal Haskell names" $ do
+      it "allows a $" $ do
+        checkIllegalNameChars ('$' :| "asdf")
+          `shouldBe` Nothing

test/Formatting.hs

@@ -5,6 +5,7 @@
 
 module Formatting (tests) where
 
+import Control.Exception
 import Data.Aeson (defaultOptions)
 import Data.Aeson.TypeScript.TH
 import Data.Aeson.TypeScript.Types
@@ -16,9 +17,17 @@ data D = S | F deriving (Eq, Show)
 
 $(deriveTypeScript defaultOptions ''D)
 
+data PrimeInType' = PrimeInType
+
+$(deriveTypeScript defaultOptions ''PrimeInType')
+
+data PrimeInConstr = PrimeInConstr'
+
+$(deriveTypeScript defaultOptions ''PrimeInConstr)
+
 tests :: Spec
 tests = do
-  describe "Formatting" $
+  describe "Formatting" $ do
     describe "when given a Sum Type" $ do
       describe "and the TypeAlias format option is set" $
         it "should generate a TS string literal type" $
@@ -32,3 +41,15 @@ tests = do
         it "should generate a TS Enum with a type declaration" $
           formatTSDeclarations' (defaultFormattingOptions { typeAlternativesFormat = EnumWithType }) (getTypeScriptDeclarations @D Proxy) `shouldBe`
             [i|enum DEnum { S="S", F="F" }\n\ntype D = keyof typeof DEnum;|]
+    describe "when the name has an apostrophe" $ do
+      describe "in the type" $ do
+        it "throws an error" $ do
+          evaluate (formatTSDeclarations' defaultFormattingOptions (getTypeScriptDeclarations @PrimeInType' Proxy))
+            `shouldThrow`
+              anyErrorCall
+      describe "in the constructor" $ do
+        it "throws an error" $ do
+          evaluate (formatTSDeclarations' defaultFormattingOptions (getTypeScriptDeclarations @PrimeInConstr Proxy))
+            `shouldThrow`
+              anyErrorCall
+

test/Spec.hs

@@ -19,14 +19,16 @@ import qualified UntaggedTagSingleConstructors
 import qualified OmitNothingFields
 import qualified NoOmitNothingFields
 import qualified UnwrapUnaryRecords
+import qualified Data.Aeson.TypeScript.LegalNameSpec as LegalNameSpec
 
 
 main :: IO ()
-main = hspec $ do
+main = hspec $ parallel $ do
   Formatting.tests
   Generic.tests
   HigherKind.tests
   ClosedTypeFamilies.tests
+  LegalNameSpec.tests
 
   ObjectWithSingleFieldTagSingleConstructors.tests
   ObjectWithSingleFieldNoTagSingleConstructors.tests

test/Util.hs

@@ -15,6 +15,7 @@ import System.Exit
 import System.FilePath
 import System.IO.Temp
 import System.Process
+import Test.Hspec
 
 npmInstallScript, yarnInstallScript, localTSC :: String
 npmInstallScript = "test/assets/npm_install.sh"