From 6e8ca2fb8dbe3cef5dc549069486ae7866b06aa1 Mon Sep 17 00:00:00 2001 From: parsonsmatt Date: Thu, 27 Oct 2022 12:49:43 -0600 Subject: [PATCH 01/10] check for illegal characters --- src/Data/Aeson/TypeScript/TH.hs | 46 +++++++++++++++++++++++++++++++++ 1 file changed, 46 insertions(+) diff --git a/src/Data/Aeson/TypeScript/TH.hs b/src/Data/Aeson/TypeScript/TH.hs index 2925c16..8fb4505 100644 --- a/src/Data/Aeson/TypeScript/TH.hs +++ b/src/Data/Aeson/TypeScript/TH.hs @@ -172,6 +172,51 @@ import qualified Language.Haskell.TH.Lib as TH import Data.Monoid #endif +-- according to https://stackoverflow.com/questions/1661197/what-characters-are-valid-for-javascript-variable-names +checkIllegalName :: Name -> Q () +checkIllegalName name = do + let + nameStr = + show name + legalFirstCategories = + Set.fromList + [ UppercaseLetter + , LowercaseLetter + , TitlecaseLetter + , ModifierLetter + , OtherLetter + , LetterNumber + ] + legalRestCategories = + Set.fromList + [ NonSpacingMark + , SpaceCombiningMark + , DecimalNumber + , ConnectorPunctation + ] + `Set.union` legalFirstCategories + isLegalFirstChar c = + c `elem` ['$', '_'] || generalCategory c `Set.elem` legalFirstCategories + isLegalRestChar c = + generalCategory c `Set.elem` legalRestCategories + (firstChar, restChars) <- + case uncons nameStr of + Just a -> pure a + Nothing -> fail "Somehow got an empty name while deriving typescript" + + unless (isLegalFirstChar firstChar) $ do + reportError $ mconcat + [ "The name ", show name, "has an illegal character: ", show char + ] + + + for restChars $ \char -> do + unless (isLegalRestChar char) $ do + reportError $ mconcat + [ "The name ", show name, "has an illegal character: ", show char + ] + + -- | Generates a 'TypeScript' instance declaration for the given data type. deriveTypeScript' :: Options -- ^ Encoding options. @@ -182,6 +227,7 @@ deriveTypeScript' :: Options -> Q [Dec] deriveTypeScript' options name extraOptions = do datatypeInfo' <- reifyDatatype name + assertExtensionsTurnedOn datatypeInfo' -- Figure out what the generic variables are From 04a684685c5e41394d7887ff04ffb81e1d784baf Mon Sep 17 00:00:00 2001 From: parsonsmatt Date: Fri, 28 Oct 2022 10:15:49 -0600 Subject: [PATCH 02/10] ok --- src/Data/Aeson/TypeScript/TH.hs | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/src/Data/Aeson/TypeScript/TH.hs b/src/Data/Aeson/TypeScript/TH.hs index 8fb4505..bc35d19 100644 --- a/src/Data/Aeson/TypeScript/TH.hs +++ b/src/Data/Aeson/TypeScript/TH.hs @@ -167,6 +167,8 @@ import Data.String.Interpolate import Language.Haskell.TH hiding (stringE) import Language.Haskell.TH.Datatype import qualified Language.Haskell.TH.Lib as TH +import qualified Data.Set as Set +import Data.Char (GeneralCategory(..), generalCategory) #if !MIN_VERSION_base(4,11,0) import Data.Monoid @@ -190,27 +192,26 @@ checkIllegalName name = do legalRestCategories = Set.fromList [ NonSpacingMark - , SpaceCombiningMark + , SpacingCombiningMark , DecimalNumber - , ConnectorPunctation + , ConnectorPunctuation ] `Set.union` legalFirstCategories isLegalFirstChar c = - c `elem` ['$', '_'] || generalCategory c `Set.elem` legalFirstCategories + c `elem` ['$', '_'] || generalCategory c `Set.member` legalFirstCategories isLegalRestChar c = - generalCategory c `Set.elem` legalRestCategories + generalCategory c `Set.member` legalRestCategories (firstChar, restChars) <- - case uncons nameStr of + case L.uncons nameStr of Just a -> pure a Nothing -> fail "Somehow got an empty name while deriving typescript" unless (isLegalFirstChar firstChar) $ do reportError $ mconcat - [ "The name ", show name, "has an illegal character: ", show char + [ "The name ", show name, "has an illegal character: ", show firstChar ] - - for restChars $ \char -> do + forM_ restChars $ \char -> do unless (isLegalRestChar char) $ do reportError $ mconcat [ "The name ", show name, "has an illegal character: ", show char From 382bb8aaa3915e9186d9a38745e657fff80c0e15 Mon Sep 17 00:00:00 2001 From: parsonsmatt Date: Sat, 29 Oct 2022 07:48:20 -0600 Subject: [PATCH 03/10] Actually call function lol --- src/Data/Aeson/TypeScript/TH.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Data/Aeson/TypeScript/TH.hs b/src/Data/Aeson/TypeScript/TH.hs index bc35d19..8c39243 100644 --- a/src/Data/Aeson/TypeScript/TH.hs +++ b/src/Data/Aeson/TypeScript/TH.hs @@ -227,6 +227,7 @@ deriveTypeScript' :: Options -- ^ Extra options to control advanced features. -> Q [Dec] deriveTypeScript' options name extraOptions = do + checkIllegalName name datatypeInfo' <- reifyDatatype name assertExtensionsTurnedOn datatypeInfo' From 8fb6b91d09321a9ac201bbb5fd034951a478aee7 Mon Sep 17 00:00:00 2001 From: parsonsmatt Date: Sat, 29 Oct 2022 08:20:26 -0600 Subject: [PATCH 04/10] Add tests, reorganize --- src/Data/Aeson/TypeScript/TH.hs | 46 ------------------------------ src/Data/Aeson/TypeScript/Util.hs | 47 +++++++++++++++++++++++++++++++ test/Spec.hs | 2 ++ test/Util.hs | 21 ++++++++++++++ 4 files changed, 70 insertions(+), 46 deletions(-) diff --git a/src/Data/Aeson/TypeScript/TH.hs b/src/Data/Aeson/TypeScript/TH.hs index 8c39243..265fc3e 100644 --- a/src/Data/Aeson/TypeScript/TH.hs +++ b/src/Data/Aeson/TypeScript/TH.hs @@ -167,57 +167,11 @@ import Data.String.Interpolate import Language.Haskell.TH hiding (stringE) import Language.Haskell.TH.Datatype import qualified Language.Haskell.TH.Lib as TH -import qualified Data.Set as Set -import Data.Char (GeneralCategory(..), generalCategory) #if !MIN_VERSION_base(4,11,0) import Data.Monoid #endif --- according to https://stackoverflow.com/questions/1661197/what-characters-are-valid-for-javascript-variable-names -checkIllegalName :: Name -> Q () -checkIllegalName name = do - let - nameStr = - show name - legalFirstCategories = - Set.fromList - [ UppercaseLetter - , LowercaseLetter - , TitlecaseLetter - , ModifierLetter - , OtherLetter - , LetterNumber - ] - legalRestCategories = - Set.fromList - [ NonSpacingMark - , SpacingCombiningMark - , DecimalNumber - , ConnectorPunctuation - ] - `Set.union` legalFirstCategories - isLegalFirstChar c = - c `elem` ['$', '_'] || generalCategory c `Set.member` legalFirstCategories - isLegalRestChar c = - generalCategory c `Set.member` legalRestCategories - (firstChar, restChars) <- - case L.uncons nameStr of - Just a -> pure a - Nothing -> fail "Somehow got an empty name while deriving typescript" - - unless (isLegalFirstChar firstChar) $ do - reportError $ mconcat - [ "The name ", show name, "has an illegal character: ", show firstChar - ] - - forM_ restChars $ \char -> do - unless (isLegalRestChar char) $ do - reportError $ mconcat - [ "The name ", show name, "has an illegal character: ", show char - ] - - -- | Generates a 'TypeScript' instance declaration for the given data type. deriveTypeScript' :: Options -- ^ Encoding options. diff --git a/src/Data/Aeson/TypeScript/Util.hs b/src/Data/Aeson/TypeScript/Util.hs index 89c771b..84839a8 100644 --- a/src/Data/Aeson/TypeScript/Util.hs +++ b/src/Data/Aeson/TypeScript/Util.hs @@ -13,6 +13,9 @@ module Data.Aeson.TypeScript.Util where +import Data.Char (GeneralCategory(..), generalCategory) +import Data.List.NonEmpty (NonEmpty(..)) +import qualified Data.List.NonEmpty as NonEmpty import Control.Monad import Data.Aeson as A import Data.Aeson.TypeScript.Instances () @@ -24,6 +27,7 @@ import qualified Data.Text as T import Language.Haskell.TH hiding (stringE) import Language.Haskell.TH.Datatype import qualified Language.Haskell.TH.Lib as TH +import qualified Data.Set as Set #if !MIN_VERSION_base(4,11,0) import Data.Monoid @@ -224,3 +228,46 @@ genericVariablesListExpr includeSuffix genericVariables = listE (fmap (\((_, (su isStarType :: Type -> Maybe Name isStarType (SigT (VarT n) StarT) = Just n isStarType _ = Nothing + +-- according to https://stackoverflow.com/questions/1661197/what-characters-are-valid-for-javascript-variable-names +checkIllegalName :: Name -> Q () +checkIllegalName name = do + case NonEmpty.nonEmpty nameStr of + Just nameChars -> + void . traverse (traverse (reportError . message)) . checkIllegalNameString $ nameChars + Nothing -> + reportError "checkIllegalName called with an empty name somehow??" + where + nameStr = + nameBase name + message c = + concat ["The name ", nameStr, "has an illegal character: ", show c] + +checkIllegalNameString :: NonEmpty Char -> Maybe (NonEmpty Char) +checkIllegalNameString nameStr = 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 + case nameStr of + firstChar :| restChars -> + filter isIllegalFirstChar [firstChar] <> filter isIllegalRestChar restChars diff --git a/test/Spec.hs b/test/Spec.hs index 611fc36..547e838 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -19,10 +19,12 @@ import qualified UntaggedTagSingleConstructors import qualified OmitNothingFields import qualified NoOmitNothingFields import qualified UnwrapUnaryRecords +import qualified Util main :: IO () main = hspec $ do + Util.utilTests Formatting.tests Generic.tests HigherKind.tests diff --git a/test/Util.hs b/test/Util.hs index ea6dfe4..e720705 100644 --- a/test/Util.hs +++ b/test/Util.hs @@ -15,6 +15,27 @@ import System.Exit import System.FilePath import System.IO.Temp import System.Process +import Test.Hspec +import Data.List.NonEmpty (NonEmpty (..)) +import Data.Aeson.TypeScript.Util + +utilTests :: Spec +utilTests = describe "Data.Aeson.TypeScript.Util" $ do + describe "checkIllegalNameString" $ do + describe "legal Haskell names" $ do + it "allows an uppercase letter" $ do + checkIllegalNameString ('A' :| []) + `shouldBe` Nothing + it "allows an underscore" $ do + checkIllegalNameString ('_' :| "asdf") + `shouldBe` Nothing + it "reports that ' is illegal" $ do + checkIllegalNameString ('F' :| "oo'") + `shouldBe` Just ('\'' :| []) + describe "illegal Haskell names" $ do + it "allows a $" $ do + checkIllegalNameString ('$' :| "asdf") + `shouldBe` Nothing npmInstallScript, yarnInstallScript, localTSC :: String npmInstallScript = "test/assets/npm_install.sh" From f22003262182f1d4ed0b51630bf811cf4c90f654 Mon Sep 17 00:00:00 2001 From: parsonsmatt Date: Sat, 29 Oct 2022 08:37:10 -0600 Subject: [PATCH 05/10] Test behavior, also check constructors --- src/Data/Aeson/TypeScript/TH.hs | 1 + src/Data/Aeson/TypeScript/Util.hs | 16 +++++++++------- test/Util.hs | 10 +++++----- 3 files changed, 15 insertions(+), 12 deletions(-) diff --git a/src/Data/Aeson/TypeScript/TH.hs b/src/Data/Aeson/TypeScript/TH.hs index 265fc3e..818d91a 100644 --- a/src/Data/Aeson/TypeScript/TH.hs +++ b/src/Data/Aeson/TypeScript/TH.hs @@ -247,6 +247,7 @@ deriveTypeScript' options name extraOptions = do -- | Return a string to go in the top-level type declaration, plus an optional expression containing a declaration handleConstructor :: Options -> DatatypeInfo -> [(Name, (Suffix, Var))] -> ConstructorInfo -> WriterT [ExtraDeclOrGenericInfo] Q Exp handleConstructor options (DatatypeInfo {..}) genericVariables ci = do + lift $ checkIllegalNameString interfaceName if | (length datatypeCons == 1) && not (getTagSingleConstructors options) -> do writeSingleConstructorEncoding brackets <- lift $ getBracketsExpression False genericVariables diff --git a/src/Data/Aeson/TypeScript/Util.hs b/src/Data/Aeson/TypeScript/Util.hs index 84839a8..1e32147 100644 --- a/src/Data/Aeson/TypeScript/Util.hs +++ b/src/Data/Aeson/TypeScript/Util.hs @@ -231,20 +231,22 @@ isStarType _ = Nothing -- according to https://stackoverflow.com/questions/1661197/what-characters-are-valid-for-javascript-variable-names checkIllegalName :: Name -> Q () -checkIllegalName name = do +checkIllegalName = + checkIllegalNameString . nameBase + +checkIllegalNameString :: String -> Q () +checkIllegalNameString nameStr = case NonEmpty.nonEmpty nameStr of Just nameChars -> - void . traverse (traverse (reportError . message)) . checkIllegalNameString $ nameChars + void . traverse (traverse (reportError . message)) . checkIllegalNameChars $ nameChars Nothing -> reportError "checkIllegalName called with an empty name somehow??" where - nameStr = - nameBase name message c = - concat ["The name ", nameStr, "has an illegal character: ", show c] + concat ["The name ", nameStr, " has an illegal character: ", show c] -checkIllegalNameString :: NonEmpty Char -> Maybe (NonEmpty Char) -checkIllegalNameString nameStr = NonEmpty.nonEmpty $ +checkIllegalNameChars :: NonEmpty Char -> Maybe (NonEmpty Char) +checkIllegalNameChars nameStr = NonEmpty.nonEmpty $ let legalFirstCategories = Set.fromList diff --git a/test/Util.hs b/test/Util.hs index e720705..89941da 100644 --- a/test/Util.hs +++ b/test/Util.hs @@ -21,20 +21,20 @@ import Data.Aeson.TypeScript.Util utilTests :: Spec utilTests = describe "Data.Aeson.TypeScript.Util" $ do - describe "checkIllegalNameString" $ do + describe "checkIllegalNameChars" $ do describe "legal Haskell names" $ do it "allows an uppercase letter" $ do - checkIllegalNameString ('A' :| []) + checkIllegalNameChars ('A' :| []) `shouldBe` Nothing it "allows an underscore" $ do - checkIllegalNameString ('_' :| "asdf") + checkIllegalNameChars ('_' :| "asdf") `shouldBe` Nothing it "reports that ' is illegal" $ do - checkIllegalNameString ('F' :| "oo'") + checkIllegalNameChars ('F' :| "oo'") `shouldBe` Just ('\'' :| []) describe "illegal Haskell names" $ do it "allows a $" $ do - checkIllegalNameString ('$' :| "asdf") + checkIllegalNameChars ('$' :| "asdf") `shouldBe` Nothing npmInstallScript, yarnInstallScript, localTSC :: String From a5730277da156f9d79df76e0b90f333ba2000f9e Mon Sep 17 00:00:00 2001 From: parsonsmatt Date: Wed, 23 Nov 2022 13:42:10 -0700 Subject: [PATCH 06/10] Add tests --- aeson-typescript.cabal | 5 +- package.yaml | 1 + src/Data/Aeson/TypeScript/LegalName.hs | 58 +++++++++++++++++++++ src/Data/Aeson/TypeScript/TH.hs | 2 - src/Data/Aeson/TypeScript/Types.hs | 24 ++++++++- src/Data/Aeson/TypeScript/Util.hs | 45 ---------------- test/Data/Aeson/TypeScript/LegalNameSpec.hs | 23 ++++++++ test/Formatting.hs | 23 +++++++- test/Spec.hs | 6 +-- test/Util.hs | 20 ------- 10 files changed, 133 insertions(+), 74 deletions(-) create mode 100644 src/Data/Aeson/TypeScript/LegalName.hs create mode 100644 test/Data/Aeson/TypeScript/LegalNameSpec.hs diff --git a/aeson-typescript.cabal b/aeson-typescript.cabal index 9e478dc..4c20e74 100644 --- a/aeson-typescript.cabal +++ b/aeson-typescript.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.0. +-- This file has been generated from package.yaml by hpack version 0.34.7. -- -- see: https://github.com/sol/hpack @@ -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 f8be48e..726b733 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..a6463fe --- /dev/null +++ b/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 . +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 diff --git a/src/Data/Aeson/TypeScript/TH.hs b/src/Data/Aeson/TypeScript/TH.hs index 818d91a..8894233 100644 --- a/src/Data/Aeson/TypeScript/TH.hs +++ b/src/Data/Aeson/TypeScript/TH.hs @@ -181,7 +181,6 @@ deriveTypeScript' :: Options -- ^ Extra options to control advanced features. -> Q [Dec] deriveTypeScript' options name extraOptions = do - checkIllegalName name datatypeInfo' <- reifyDatatype name assertExtensionsTurnedOn datatypeInfo' @@ -247,7 +246,6 @@ deriveTypeScript' options name extraOptions = do -- | Return a string to go in the top-level type declaration, plus an optional expression containing a declaration handleConstructor :: Options -> DatatypeInfo -> [(Name, (Suffix, Var))] -> ConstructorInfo -> WriterT [ExtraDeclOrGenericInfo] Q Exp handleConstructor options (DatatypeInfo {..}) genericVariables ci = do - lift $ checkIllegalNameString interfaceName if | (length datatypeCons == 1) && not (getTagSingleConstructors options) -> do writeSingleConstructorEncoding brackets <- lift $ getBracketsExpression False genericVariables 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/src/Data/Aeson/TypeScript/Util.hs b/src/Data/Aeson/TypeScript/Util.hs index 1e32147..66c983f 100644 --- a/src/Data/Aeson/TypeScript/Util.hs +++ b/src/Data/Aeson/TypeScript/Util.hs @@ -228,48 +228,3 @@ genericVariablesListExpr includeSuffix genericVariables = listE (fmap (\((_, (su isStarType :: Type -> Maybe Name isStarType (SigT (VarT n) StarT) = Just n isStarType _ = Nothing - --- according to https://stackoverflow.com/questions/1661197/what-characters-are-valid-for-javascript-variable-names -checkIllegalName :: Name -> Q () -checkIllegalName = - checkIllegalNameString . nameBase - -checkIllegalNameString :: String -> Q () -checkIllegalNameString nameStr = - case NonEmpty.nonEmpty nameStr of - Just nameChars -> - void . 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] - -checkIllegalNameChars :: NonEmpty Char -> Maybe (NonEmpty Char) -checkIllegalNameChars nameStr = 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 - case nameStr of - firstChar :| restChars -> - filter isIllegalFirstChar [firstChar] <> filter isIllegalRestChar restChars 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 547e838..83ee5fa 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -19,16 +19,16 @@ import qualified UntaggedTagSingleConstructors import qualified OmitNothingFields import qualified NoOmitNothingFields import qualified UnwrapUnaryRecords -import qualified Util +import qualified Data.Aeson.TypeScript.LegalNameSpec as LegalNameSpec main :: IO () -main = hspec $ do - Util.utilTests +main = hspec $ parallel $ do Formatting.tests Generic.tests HigherKind.tests ClosedTypeFamilies.tests + LegalNameSpec.tests ObjectWithSingleFieldTagSingleConstructors.tests ObjectWithSingleFieldNoTagSingleConstructors.tests diff --git a/test/Util.hs b/test/Util.hs index 89941da..01a70ca 100644 --- a/test/Util.hs +++ b/test/Util.hs @@ -16,26 +16,6 @@ import System.FilePath import System.IO.Temp import System.Process import Test.Hspec -import Data.List.NonEmpty (NonEmpty (..)) -import Data.Aeson.TypeScript.Util - -utilTests :: Spec -utilTests = describe "Data.Aeson.TypeScript.Util" $ 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 npmInstallScript, yarnInstallScript, localTSC :: String npmInstallScript = "test/assets/npm_install.sh" From 574c64d9c195d030365081d92bf45044987fa5b7 Mon Sep 17 00:00:00 2001 From: parsonsmatt Date: Wed, 23 Nov 2022 13:44:29 -0700 Subject: [PATCH 07/10] sweet --- src/Data/Aeson/TypeScript/TH.hs | 1 - src/Data/Aeson/TypeScript/Util.hs | 4 ---- 2 files changed, 5 deletions(-) diff --git a/src/Data/Aeson/TypeScript/TH.hs b/src/Data/Aeson/TypeScript/TH.hs index 8894233..2925c16 100644 --- a/src/Data/Aeson/TypeScript/TH.hs +++ b/src/Data/Aeson/TypeScript/TH.hs @@ -182,7 +182,6 @@ deriveTypeScript' :: Options -> Q [Dec] deriveTypeScript' options name extraOptions = do datatypeInfo' <- reifyDatatype name - assertExtensionsTurnedOn datatypeInfo' -- Figure out what the generic variables are diff --git a/src/Data/Aeson/TypeScript/Util.hs b/src/Data/Aeson/TypeScript/Util.hs index 66c983f..89c771b 100644 --- a/src/Data/Aeson/TypeScript/Util.hs +++ b/src/Data/Aeson/TypeScript/Util.hs @@ -13,9 +13,6 @@ module Data.Aeson.TypeScript.Util where -import Data.Char (GeneralCategory(..), generalCategory) -import Data.List.NonEmpty (NonEmpty(..)) -import qualified Data.List.NonEmpty as NonEmpty import Control.Monad import Data.Aeson as A import Data.Aeson.TypeScript.Instances () @@ -27,7 +24,6 @@ import qualified Data.Text as T import Language.Haskell.TH hiding (stringE) import Language.Haskell.TH.Datatype import qualified Language.Haskell.TH.Lib as TH -import qualified Data.Set as Set #if !MIN_VERSION_base(4,11,0) import Data.Monoid From dc81783765ad91cd03d262b7f00979d6e88d9abf Mon Sep 17 00:00:00 2001 From: parsonsmatt Date: Wed, 23 Nov 2022 13:44:51 -0700 Subject: [PATCH 08/10] k --- aeson-typescript.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/aeson-typescript.cabal b/aeson-typescript.cabal index 4c20e74..3c3a943 100644 --- a/aeson-typescript.cabal +++ b/aeson-typescript.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.7. +-- This file has been generated from package.yaml by hpack version 0.35.0. -- -- see: https://github.com/sol/hpack From 9ac89dde9b040f36a6883b090b94100881b26bb6 Mon Sep 17 00:00:00 2001 From: parsonsmatt Date: Wed, 23 Nov 2022 13:46:33 -0700 Subject: [PATCH 09/10] Add changelog entry --- CHANGELOG.md | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 5b30661..1cadc19 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.1.0 * Add TypeScript Int16 From 21495cab19726a1323d1c78b06a40fc9cea5703d Mon Sep 17 00:00:00 2001 From: parsonsmatt Date: Mon, 5 Dec 2022 15:21:46 -0700 Subject: [PATCH 10/10] Address review comments --- src/Data/Aeson/TypeScript/LegalName.hs | 23 ++--------------------- src/Data/Aeson/TypeScript/TH.hs | 1 + test/Util.hs | 1 - 3 files changed, 3 insertions(+), 22 deletions(-) diff --git a/src/Data/Aeson/TypeScript/LegalName.hs b/src/Data/Aeson/TypeScript/LegalName.hs index a6463fe..06201ad 100644 --- a/src/Data/Aeson/TypeScript/LegalName.hs +++ b/src/Data/Aeson/TypeScript/LegalName.hs @@ -1,5 +1,5 @@ --- | This module defines functions which are useful for determing if --- a given name is a legal JavaScript name accord to . +-- | 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 @@ -9,25 +9,6 @@ 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) 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/test/Util.hs b/test/Util.hs index 01a70ca..ea6dfe4 100644 --- a/test/Util.hs +++ b/test/Util.hs @@ -15,7 +15,6 @@ 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"