diff --git a/CHANGELOG.md b/CHANGELOG.md index 455de03..7b53dac 100644 --- a/CHANGELOG.md +++ b/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 diff --git a/aeson-typescript.cabal b/aeson-typescript.cabal index c03bc69..54e8557 100644 --- a/aeson-typescript.cabal +++ b/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 diff --git a/package.yaml b/package.yaml index 53c2e6a..49a963e 100644 --- a/package.yaml +++ b/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: diff --git a/src/Data/Aeson/TypeScript/LegalName.hs b/src/Data/Aeson/TypeScript/LegalName.hs new file mode 100644 index 0000000..06201ad --- /dev/null +++ b/src/Data/Aeson/TypeScript/LegalName.hs @@ -0,0 +1,39 @@ +-- | This module defines functions which are useful for determining if +-- a given name is a legal JavaScript name according to . +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 + +-- | 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 diff --git a/src/Data/Aeson/TypeScript/TH.hs b/src/Data/Aeson/TypeScript/TH.hs index 2925c16..f7ec6bc 100644 --- a/src/Data/Aeson/TypeScript/TH.hs +++ b/src/Data/Aeson/TypeScript/TH.hs @@ -127,6 +127,7 @@ module Data.Aeson.TypeScript.TH ( , formatTSDeclaration , FormattingOptions(..) , defaultFormattingOptions + , defaultNameFormatter , SumTypeFormat(..) , ExportMode(..) diff --git a/src/Data/Aeson/TypeScript/Types.hs b/src/Data/Aeson/TypeScript/Types.hs index e3c7c6c..3398ffa 100644 --- a/src/Data/Aeson/TypeScript/Types.hs +++ b/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 diff --git a/test/Data/Aeson/TypeScript/LegalNameSpec.hs b/test/Data/Aeson/TypeScript/LegalNameSpec.hs new file mode 100644 index 0000000..dda1429 --- /dev/null +++ b/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 diff --git a/test/Formatting.hs b/test/Formatting.hs index 136751d..4f10865 100644 --- a/test/Formatting.hs +++ b/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 + diff --git a/test/Spec.hs b/test/Spec.hs index 611fc36..83ee5fa 100644 --- a/test/Spec.hs +++ b/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