diff --git a/aeson-typescript.cabal b/aeson-typescript.cabal --- a/aeson-typescript.cabal +++ b/aeson-typescript.cabal @@ -1,11 +1,11 @@ --- This file has been generated from package.yaml by hpack version 0.20.0. +-- This file has been generated from package.yaml by hpack version 0.28.2. -- -- see: https://github.com/sol/hpack -- --- hash: 955d088f08ff0d1d6b9e1a389ad440845d1cf3ba994ea4da1b02c86925ccae30 +-- hash: ce032fc67fc5fe38fd92293c2e9fa99c35626673cdf99cf3733ccd2d56cd8d0a name: aeson-typescript -version: 0.1.0.6 +version: 0.1.1.0 synopsis: Generate TypeScript definition files from your ADTs description: Please see the README on Github at category: Text, Web, JSON @@ -19,7 +19,6 @@ tested-with: GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.2 build-type: Simple cabal-version: >= 1.10 - extra-source-files: ChangeLog.md README.md @@ -60,7 +59,7 @@ hs-source-dirs: test src - ghc-options: -threaded -rtsopts -with-rtsopts=-N + ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N build-depends: aeson , aeson-typescript @@ -80,14 +79,15 @@ , unordered-containers other-modules: HigherKind - Misc ObjectWithSingleFieldNoTagSingleConstructors ObjectWithSingleFieldTagSingleConstructors TaggedObjectNoTagSingleConstructors TaggedObjectTagSingleConstructors + TestBoilerplate TwoElemArrayNoTagSingleConstructors TwoElemArrayTagSingleConstructors - Untagged + UntaggedNoTagSingleConstructors + UntaggedTagSingleConstructors Util Data.Aeson.TypeScript.Formatting Data.Aeson.TypeScript.Instances diff --git a/src/Data/Aeson/TypeScript/Formatting.hs b/src/Data/Aeson/TypeScript/Formatting.hs --- a/src/Data/Aeson/TypeScript/Formatting.hs +++ b/src/Data/Aeson/TypeScript/Formatting.hs @@ -2,21 +2,13 @@ module Data.Aeson.TypeScript.Formatting where -import Control.Monad -import Control.Monad.Writer -import Control.Monad.Writer.Lazy -import qualified Data.Aeson as A import Data.Aeson.TypeScript.Types -import Data.Data import Data.Monoid -import Data.String import Data.String.Interpolate.IsString import qualified Data.Text as T -import qualified Data.Text.IO as T -import Language.Haskell.TH -import Language.Haskell.TH.Datatype -- | Same as 'formatTSDeclarations'', but uses default formatting options. +formatTSDeclarations :: [TSDeclaration] -> String formatTSDeclarations = formatTSDeclarations' defaultFormattingOptions -- | Format a single TypeScript declaration. This version accepts a FormattingOptions object in case you want more control over the output. diff --git a/src/Data/Aeson/TypeScript/Instances.hs b/src/Data/Aeson/TypeScript/Instances.hs --- a/src/Data/Aeson/TypeScript/Instances.hs +++ b/src/Data/Aeson/TypeScript/Instances.hs @@ -5,26 +5,15 @@ module Data.Aeson.TypeScript.Instances where -import Control.Monad -import Control.Monad.Writer -import Control.Monad.Writer.Lazy import qualified Data.Aeson as A -import qualified Data.Aeson.TH as A import Data.Aeson.TypeScript.Types import Data.Data import Data.HashMap.Strict import Data.Monoid -import Data.Proxy import Data.Set -import Data.String import Data.String.Interpolate.IsString import qualified Data.Text as T -import qualified Data.Text.IO as T import qualified Data.Text.Lazy as TL -import Language.Haskell.TH -import Language.Haskell.TH.Datatype -import Language.Haskell.TH.Quote -import Language.Haskell.TH.Syntax instance TypeScript () where getTypeScriptType _ = "void" diff --git a/src/Data/Aeson/TypeScript/TH.hs b/src/Data/Aeson/TypeScript/TH.hs --- a/src/Data/Aeson/TypeScript/TH.hs +++ b/src/Data/Aeson/TypeScript/TH.hs @@ -37,12 +37,22 @@ @ >>> putStrLn $ 'formatTSDeclarations' $ 'getTypeScriptDeclarations' (Proxy :: Proxy D) -type D\ = "nullary" | IUnary\ | IProduct\ | IRecord\; +type D\ = INullary\ | IUnary\ | IProduct\ | IRecord\; -type IUnary\ = number; +interface INullary\ { + tag: "nullary"; +} -type IProduct\ = [string, string, T]; +interface IUnary\ { + tag: "unary"; + contents: number; +} +interface IProduct\ { + tag: "product"; + contents: [string, string, T]; +} + interface IRecord\ { tag: "record"; One: number; @@ -114,8 +124,6 @@ import Data.Aeson.TypeScript.Formatting import Data.Aeson.TypeScript.Instances () import Data.Aeson.TypeScript.Types -import Data.Aeson.Types as A -import Data.List (inits, tails) import qualified Data.Map as M import Data.Maybe import Data.Monoid @@ -211,9 +219,6 @@ | otherwise -> ["T" <> show i | i <- [1..(length datatypeVars)]] let genericVariablesExp = ListE [stringE x | x <- genericVariables] - let allNullary = (allNullaryToStringTag options) && (allConstructorsAreNullary datatypeCons) - let singleNormalConstructor = (length datatypeCons == 1) && ((constructorVariant $ head datatypeCons) == NormalConstructor) - declarationFnBody <- do let interfaceNamesAndDeclarations = fmap (handleConstructor options datatypeInfo genericVariables) datatypeCons let interfaceNames = fmap fst interfaceNamesAndDeclarations @@ -228,41 +233,52 @@ -- | Return a string to go in the top-level type declaration, plus an optional expression containing a declaration handleConstructor :: Options -> DatatypeInfo -> [String] -> ConstructorInfo -> (Exp, Maybe Exp) -handleConstructor options (DatatypeInfo {..}) genericVariables (ConstructorInfo {..}) = (typeDeclarationToUse, declaration) +handleConstructor options (DatatypeInfo {..}) genericVariables ci@(ConstructorInfo {}) = + if | isSingleConstructorType && not (getTagSingleConstructors options) -> (stringE interfaceName, singleConstructorEncoding) + + | allConstructorsAreNullary datatypeCons && allNullaryToStringTag options -> stringEncoding + -- With UntaggedValue, nullary constructors are encoded as strings + | (isUntaggedValue $ sumEncoding options) && isConstructorNullary ci -> stringEncoding + + -- Treat as a sum + | isObjectWithSingleField $ sumEncoding options -> (stringE [i|{#{show constructorNameToUse}: #{interfaceName}}|], singleConstructorEncoding) + | isTwoElemArray $ sumEncoding options -> (stringE [i|[#{show constructorNameToUse}, #{interfaceName}]|], singleConstructorEncoding) + | isUntaggedValue $ sumEncoding options -> (stringE interfaceName, singleConstructorEncoding) + | otherwise -> (stringE interfaceName, taggedConstructorEncoding) + where + stringEncoding = (stringE [i|"#{(constructorTagModifier options) $ getTypeName (constructorName ci)}"|], Nothing) + + singleConstructorEncoding = if | constructorVariant ci == NormalConstructor -> tupleEncoding + | otherwise -> Just $ assembleInterfaceDeclaration options (constructorName ci) genericVariables (ListE (getTSFields namesAndTypes)) + + taggedConstructorEncoding = Just $ assembleInterfaceDeclaration options (constructorName ci) genericVariables (ListE (tagField ++ getTSFields namesAndTypes)) + -- * Type declaration to use - interfaceName = getInterfaceName constructorName <> (getGenericBrackets genericVariables) - typeDeclarationToUse = if | shouldEncodeToString -> stringE [i|"#{(constructorTagModifier options) $ getTypeName $ constructorName}"|] - | (isObjectWithSingleField $ sumEncoding options) && shouldTag -> stringE [i|{#{show constructorNameToUse}: #{interfaceName}}|] - | (isTwoElemArray $ sumEncoding options) && shouldTag -> stringE [i|[#{show constructorNameToUse}, #{interfaceName}]|] - | otherwise -> stringE interfaceName + interfaceName = getInterfaceName (constructorName ci) <> getGenericBrackets genericVariables - -- * Declaration - shouldEncodeToString = null constructorFields && shouldTag - shouldEncodeToTuple = (constructorVariant == NormalConstructor) && (not $ (isTaggedObject options && (getTagSingleConstructors options))) - declaration = if | shouldEncodeToString -> Nothing - | shouldEncodeToTuple -> Just $ applyToArgsE (ConE 'TSTypeAlternatives) [stringE $ getInterfaceName constructorName, - ListE [stringE x | x <- genericVariables], - ListE [getTypeAsStringExp contentsTupleType]] - | otherwise -> Just $ assembleInterfaceDeclaration options constructorName genericVariables (ListE $ (tagField ++ getTSFields namesAndTypes)) - where - namesAndTypes :: [(String, Type)] = case constructorVariant of - RecordConstructor names -> zip (fmap ((fieldLabelModifier options) . lastNameComponent') names) constructorFields - NormalConstructor -> case sumEncoding options of - TaggedObject tagFieldName contentsFieldName -> [(contentsFieldName, contentsTupleType)] - _ -> [(constructorNameToUse, contentsTupleType)] + tupleEncoding = Just $ applyToArgsE (ConE 'TSTypeAlternatives) [stringE $ getInterfaceName (constructorName ci) + , ListE [stringE x | x <- genericVariables] + , ListE [getTypeAsStringExp contentsTupleType]] - tagField = case sumEncoding options of - TaggedObject tagFieldName contentsFieldName | shouldTag -> [(AppE (AppE (AppE (ConE 'TSField) (ConE 'False)) - (stringE tagFieldName)) - (stringE $ [i|"#{constructorNameToUse}"|]))] - _ -> [] + namesAndTypes :: [(String, Type)] = case constructorVariant ci of + RecordConstructor names -> zip (fmap ((fieldLabelModifier options) . lastNameComponent') names) (constructorFields ci) + NormalConstructor -> case sumEncoding options of + TaggedObject _ contentsFieldName -> if | isConstructorNullary ci -> [] + | otherwise -> [(contentsFieldName, contentsTupleType)] + _ -> [(constructorNameToUse, contentsTupleType)] - shouldTag = (((length datatypeCons) > 1) || (getTagSingleConstructors options)) - constructorNameToUse = (constructorTagModifier options) $ lastNameComponent' constructorName - contentsTupleType = getTupleType constructorFields + tagField = case sumEncoding options of + TaggedObject tagFieldName _ -> [(AppE (AppE (AppE (ConE 'TSField) (ConE 'False)) + (stringE tagFieldName)) + (stringE [i|"#{constructorNameToUse}"|]))] + _ -> [] + isSingleConstructorType = length datatypeCons == 1 + constructorNameToUse = (constructorTagModifier options) $ lastNameComponent' (constructorName ci) + contentsTupleType = getTupleType (constructorFields ci) + -- | Helper for handleConstructor getTSFields :: [(String, Type)] -> [Exp] getTSFields namesAndTypes = [(AppE (AppE (AppE (ConE 'TSField) (getOptionalAsBoolExp typ)) @@ -380,7 +396,7 @@ #if MIN_VERSION_aeson(1,2,0) getTagSingleConstructors options = tagSingleConstructors options #else -getTagSingleConstructors options = False +getTagSingleConstructors _ = False #endif -- Between Template Haskell 2.10 and 2.11, the ability to look up which extensions are turned on was added @@ -403,3 +419,10 @@ -- Older versions of Aeson don't have an Eq instance for SumEncoding so we do this isTwoElemArray TwoElemArray = True isTwoElemArray _ = False + +-- Older versions of Aeson don't have an Eq instance for SumEncoding so we do this +-- UntaggedValue was added between Aeson 0.11.3.0 and 1.0.0.0 +#if MIN_VERSION_aeson(1,0,0) +isUntaggedValue UntaggedValue = True +#endif +isUntaggedValue _ = False diff --git a/src/Data/Aeson/TypeScript/Types.hs b/src/Data/Aeson/TypeScript/Types.hs --- a/src/Data/Aeson/TypeScript/Types.hs +++ b/src/Data/Aeson/TypeScript/Types.hs @@ -2,21 +2,10 @@ module Data.Aeson.TypeScript.Types where -import Control.Monad -import Control.Monad.Writer -import Control.Monad.Writer.Lazy import qualified Data.Aeson as A -import qualified Data.Aeson.Types as A +import qualified Data.Aeson.TH as A import Data.Data -import Data.Monoid -import Data.Proxy -import Data.Set import Data.String -import Data.String.Interpolate.IsString -import qualified Data.Text as T -import qualified Data.Text.IO as T -import Language.Haskell.TH -import Language.Haskell.TH.Datatype -- | The typeclass that defines how a type is turned into TypeScript. -- diff --git a/test/HigherKind.hs b/test/HigherKind.hs --- a/test/HigherKind.hs +++ b/test/HigherKind.hs @@ -10,7 +10,6 @@ import Data.Proxy import Data.String.Interpolate.IsString import Prelude hiding (Double) -import System.IO.Unsafe (unsafePerformIO) import Test.Hspec import Util diff --git a/test/Misc.hs b/test/Misc.hs deleted file mode 100644 --- a/test/Misc.hs +++ /dev/null @@ -1,74 +0,0 @@ -{-# LANGUAGE QuasiQuotes, OverloadedStrings, TemplateHaskell, RecordWildCards, ScopedTypeVariables, NamedFieldPuns, KindSignatures #-} - -module Misc where - -import Data.Aeson as A -import Data.Aeson.TH as A -import Data.Aeson.TypeScript.TH -import qualified Data.ByteString.Lazy.Char8 as BL8 -import Data.Char -import Data.Monoid ((<>)) -import Data.Proxy -import Data.String.Interpolate.IsString -import Language.Haskell.TH -import Language.Haskell.TH.Datatype -import Prelude hiding (Double) -import System.IO.Unsafe (unsafePerformIO) -import Test.Hspec - -import Debug.Trace - -data HigherKind a = HigherKind { higherKindList :: [a] } - -$(deriveTypeScript A.defaultOptions ''HigherKind) - -data Foo = Foo { fooString :: String - , fooInt :: Int } - | Bar { barString :: String - , barMaybe :: Maybe Int - , bazReference :: Baz - , higherKindReference :: HigherKind String } - -data Baz = Baz { bazString :: String } - -$(deriveTypeScript A.defaultOptions ''Foo) -$(deriveTypeScript A.defaultOptions ''Baz) - - -data EvenHigherKind a b = EvenHigherKind { someList :: [b] - , higherKindThing :: HigherKind a } - -$(deriveTypeScript A.defaultOptions ''EvenHigherKind) - -main = putStrLn $ formatTSDeclarations ( - (getTypeScriptDeclarations (Proxy :: Proxy HigherKind)) - <> (getTypeScriptDeclarations (Proxy :: Proxy Foo)) - <> (getTypeScriptDeclarations (Proxy :: Proxy Baz)) - <> (getTypeScriptDeclarations (Proxy :: Proxy D)) - <> (getTypeScriptDeclarations (Proxy :: Proxy EvenHigherKind)) - ) - - -data D a = Nullary - | Unary Int - | Product String Char a - | Record { testOne :: Int - , testTwo :: Bool - , testThree :: D a - } deriving Eq - -d :: D Int -d = Record { testOne = 3 - , testTwo = True - , testThree = Product "test" 'A' 123 - } - -$(deriveTypeScript (defaultOptions{fieldLabelModifier = drop 4, constructorTagModifier = map toLower}) ''D) -$(deriveJSON (defaultOptions{fieldLabelModifier = drop 4, constructorTagModifier = map toLower}) ''D) - - --- type JupyterInterpreterType = String --- data InterpreterType = Normal --- | Jupyter JupyterInterpreterType deriving (Eq, Ord, Show) - --- $(deriveTypeScript (A.defaultOptions { sumEncoding=UntaggedValue }) ''InterpreterType) diff --git a/test/ObjectWithSingleFieldNoTagSingleConstructors.hs b/test/ObjectWithSingleFieldNoTagSingleConstructors.hs --- a/test/ObjectWithSingleFieldNoTagSingleConstructors.hs +++ b/test/ObjectWithSingleFieldNoTagSingleConstructors.hs @@ -1,67 +1,13 @@ -{-# LANGUAGE QuasiQuotes, OverloadedStrings, TemplateHaskell, RecordWildCards, ScopedTypeVariables, NamedFieldPuns #-} +{-# LANGUAGE QuasiQuotes, OverloadedStrings, TemplateHaskell, RecordWildCards, ScopedTypeVariables, NamedFieldPuns, KindSignatures #-} module ObjectWithSingleFieldNoTagSingleConstructors (tests) where import Data.Aeson as A import Data.Aeson.TH as A -import Data.Aeson.TypeScript.TH -import Data.Monoid -import Data.Proxy -import Data.String.Interpolate.IsString -import Prelude hiding (Double) -import System.IO.Unsafe (unsafePerformIO) import Test.Hspec +import TestBoilerplate import Util - -data Unit = Unit -$(deriveJSON (A.defaultOptions {sumEncoding=ObjectWithSingleField}) ''Unit) -$(deriveTypeScript (A.defaultOptions {sumEncoding=ObjectWithSingleField}) ''Unit) - -data OneFieldRecordless = OneFieldRecordless Int -$(deriveJSON (A.defaultOptions {sumEncoding=ObjectWithSingleField}) ''OneFieldRecordless) -$(deriveTypeScript (A.defaultOptions {sumEncoding=ObjectWithSingleField}) ''OneFieldRecordless) - -data OneField = OneField { simpleString :: String } -$(deriveJSON (A.defaultOptions {sumEncoding=ObjectWithSingleField}) ''OneField) -$(deriveTypeScript (A.defaultOptions {sumEncoding=ObjectWithSingleField}) ''OneField) - -data TwoFieldRecordless = TwoFieldRecordless Int String -$(deriveJSON (A.defaultOptions {sumEncoding=ObjectWithSingleField}) ''TwoFieldRecordless) -$(deriveTypeScript (A.defaultOptions {sumEncoding=ObjectWithSingleField}) ''TwoFieldRecordless) - -data TwoField = TwoField { doubleInt :: Int - , doubleString :: String } -$(deriveJSON (A.defaultOptions {sumEncoding=ObjectWithSingleField}) ''TwoField) -$(deriveTypeScript (A.defaultOptions {sumEncoding=ObjectWithSingleField}) ''TwoField) - -data TwoConstructor = Con1 { con1String :: String } - | Con2 { con2String :: String - , con2Int :: Int } -$(deriveJSON (A.defaultOptions {sumEncoding=ObjectWithSingleField}) ''TwoConstructor) -$(deriveTypeScript (A.defaultOptions {sumEncoding=ObjectWithSingleField}) ''TwoConstructor) - - -declarations = ((getTypeScriptDeclarations (Proxy :: Proxy Unit)) <> - (getTypeScriptDeclarations (Proxy :: Proxy OneFieldRecordless)) <> - (getTypeScriptDeclarations (Proxy :: Proxy OneField)) <> - (getTypeScriptDeclarations (Proxy :: Proxy TwoFieldRecordless)) <> - (getTypeScriptDeclarations (Proxy :: Proxy TwoField)) <> - (getTypeScriptDeclarations (Proxy :: Proxy TwoConstructor)) - ) - -typesAndValues = [(getTypeScriptType (Proxy :: Proxy Unit) , A.encode Unit) - , (getTypeScriptType (Proxy :: Proxy OneFieldRecordless) , A.encode $ OneFieldRecordless 42) - , (getTypeScriptType (Proxy :: Proxy OneField) , A.encode $ OneField "asdf") - , (getTypeScriptType (Proxy :: Proxy TwoFieldRecordless) , A.encode $ TwoFieldRecordless 42 "asdf") - , (getTypeScriptType (Proxy :: Proxy TwoField) , A.encode $ TwoField 42 "asdf") - , (getTypeScriptType (Proxy :: Proxy TwoConstructor) , A.encode $ Con1 "asdf") - , (getTypeScriptType (Proxy :: Proxy TwoConstructor) , A.encode $ Con2 "asdf" 42) - ] - -tests = describe "ObjectWithSingleField with tagSingleConstructors=False" $ do - it "type checks everything with tsc" $ do - testTypeCheckDeclarations declarations typesAndValues - +$(testDeclarations "ObjectWithSingleField with tagSingleConstructors=False" (A.defaultOptions {sumEncoding=ObjectWithSingleField})) main = hspec tests diff --git a/test/ObjectWithSingleFieldTagSingleConstructors.hs b/test/ObjectWithSingleFieldTagSingleConstructors.hs --- a/test/ObjectWithSingleFieldTagSingleConstructors.hs +++ b/test/ObjectWithSingleFieldTagSingleConstructors.hs @@ -1,67 +1,13 @@ -{-# LANGUAGE QuasiQuotes, OverloadedStrings, TemplateHaskell, RecordWildCards, ScopedTypeVariables, NamedFieldPuns #-} +{-# LANGUAGE QuasiQuotes, OverloadedStrings, TemplateHaskell, RecordWildCards, ScopedTypeVariables, NamedFieldPuns, KindSignatures #-} module ObjectWithSingleFieldTagSingleConstructors (tests) where import Data.Aeson as A import Data.Aeson.TH as A -import Data.Aeson.TypeScript.TH -import Data.Monoid -import Data.Proxy -import Data.String.Interpolate.IsString -import Prelude hiding (Double) -import System.IO.Unsafe (unsafePerformIO) import Test.Hspec +import TestBoilerplate import Util - -data Unit = Unit -$(deriveJSON (setTagSingleConstructors $ A.defaultOptions {sumEncoding=ObjectWithSingleField}) ''Unit) -$(deriveTypeScript (setTagSingleConstructors $ A.defaultOptions {sumEncoding=ObjectWithSingleField}) ''Unit) - -data OneFieldRecordless = OneFieldRecordless Int -$(deriveJSON (setTagSingleConstructors $ A.defaultOptions {sumEncoding=ObjectWithSingleField}) ''OneFieldRecordless) -$(deriveTypeScript (setTagSingleConstructors $ A.defaultOptions {sumEncoding=ObjectWithSingleField}) ''OneFieldRecordless) - -data OneField = OneField { simpleString :: String } -$(deriveJSON (setTagSingleConstructors $ A.defaultOptions {sumEncoding=ObjectWithSingleField}) ''OneField) -$(deriveTypeScript (setTagSingleConstructors $ A.defaultOptions {sumEncoding=ObjectWithSingleField}) ''OneField) - -data TwoFieldRecordless = TwoFieldRecordless Int String -$(deriveJSON (setTagSingleConstructors $ A.defaultOptions {sumEncoding=ObjectWithSingleField}) ''TwoFieldRecordless) -$(deriveTypeScript (setTagSingleConstructors $ A.defaultOptions {sumEncoding=ObjectWithSingleField}) ''TwoFieldRecordless) - -data TwoField = TwoField { doubleInt :: Int - , doubleString :: String } -$(deriveJSON (setTagSingleConstructors $ A.defaultOptions {sumEncoding=ObjectWithSingleField}) ''TwoField) -$(deriveTypeScript (setTagSingleConstructors $ A.defaultOptions {sumEncoding=ObjectWithSingleField}) ''TwoField) - -data TwoConstructor = Con1 { con1String :: String } - | Con2 { con2String :: String - , con2Int :: Int } -$(deriveJSON (setTagSingleConstructors $ A.defaultOptions {sumEncoding=ObjectWithSingleField}) ''TwoConstructor) -$(deriveTypeScript (setTagSingleConstructors $ A.defaultOptions {sumEncoding=ObjectWithSingleField}) ''TwoConstructor) - - -declarations = ((getTypeScriptDeclarations (Proxy :: Proxy Unit)) <> - (getTypeScriptDeclarations (Proxy :: Proxy OneFieldRecordless)) <> - (getTypeScriptDeclarations (Proxy :: Proxy OneField)) <> - (getTypeScriptDeclarations (Proxy :: Proxy TwoFieldRecordless)) <> - (getTypeScriptDeclarations (Proxy :: Proxy TwoField)) <> - (getTypeScriptDeclarations (Proxy :: Proxy TwoConstructor)) - ) - -typesAndValues = [(getTypeScriptType (Proxy :: Proxy Unit) , A.encode Unit) - , (getTypeScriptType (Proxy :: Proxy OneFieldRecordless) , A.encode $ OneFieldRecordless 42) - , (getTypeScriptType (Proxy :: Proxy OneField) , A.encode $ OneField "asdf") - , (getTypeScriptType (Proxy :: Proxy TwoFieldRecordless) , A.encode $ TwoFieldRecordless 42 "asdf") - , (getTypeScriptType (Proxy :: Proxy TwoField) , A.encode $ TwoField 42 "asdf") - , (getTypeScriptType (Proxy :: Proxy TwoConstructor) , A.encode $ Con1 "asdf") - , (getTypeScriptType (Proxy :: Proxy TwoConstructor) , A.encode $ Con2 "asdf" 42) - ] - - -tests = describe "ObjectWithSingleField with tagSingleConstructors=True" $ do - it "type checks everything with tsc" $ do - testTypeCheckDeclarations declarations typesAndValues +$(testDeclarations "ObjectWithSingleField with tagSingleConstructors=True" (setTagSingleConstructors $ A.defaultOptions {sumEncoding=ObjectWithSingleField})) main = hspec tests diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -3,14 +3,15 @@ import Test.Hspec -import HigherKind as HigherKind -import ObjectWithSingleFieldNoTagSingleConstructors as ObjectWithSingleFieldNoTagSingleConstructors -import ObjectWithSingleFieldTagSingleConstructors as ObjectWithSingleFieldTagSingleConstructors -import TaggedObjectNoTagSingleConstructors as TaggedObjectNoTagSingleConstructors -import TaggedObjectTagSingleConstructors as TaggedObjectTagSingleConstructors -import TwoElemArrayNoTagSingleConstructors as TwoElemArrayNoTagSingleConstructors -import TwoElemArrayTagSingleConstructors as TwoElemArrayTagSingleConstructors -import Untagged as Untagged +import qualified HigherKind +import qualified ObjectWithSingleFieldNoTagSingleConstructors +import qualified ObjectWithSingleFieldTagSingleConstructors +import qualified TaggedObjectNoTagSingleConstructors +import qualified TaggedObjectTagSingleConstructors +import qualified TwoElemArrayNoTagSingleConstructors +import qualified TwoElemArrayTagSingleConstructors +import qualified UntaggedNoTagSingleConstructors +import qualified UntaggedTagSingleConstructors main = hspec $ do ObjectWithSingleFieldTagSingleConstructors.tests @@ -19,5 +20,6 @@ TaggedObjectNoTagSingleConstructors.tests TwoElemArrayTagSingleConstructors.tests TwoElemArrayNoTagSingleConstructors.tests - Untagged.tests + UntaggedTagSingleConstructors.tests + UntaggedNoTagSingleConstructors.tests HigherKind.tests diff --git a/test/TaggedObjectNoTagSingleConstructors.hs b/test/TaggedObjectNoTagSingleConstructors.hs --- a/test/TaggedObjectNoTagSingleConstructors.hs +++ b/test/TaggedObjectNoTagSingleConstructors.hs @@ -1,67 +1,13 @@ -{-# LANGUAGE QuasiQuotes, OverloadedStrings, TemplateHaskell, RecordWildCards, ScopedTypeVariables, NamedFieldPuns #-} +{-# LANGUAGE QuasiQuotes, OverloadedStrings, TemplateHaskell, RecordWildCards, ScopedTypeVariables, NamedFieldPuns, KindSignatures #-} module TaggedObjectNoTagSingleConstructors (tests) where import Data.Aeson as A import Data.Aeson.TH as A -import Data.Aeson.TypeScript.TH -import Data.Monoid -import Data.Proxy -import Data.String.Interpolate.IsString -import qualified Data.Text as T -import Prelude hiding (Double) -import System.FilePath -import System.IO.Unsafe (unsafePerformIO) import Test.Hspec +import TestBoilerplate import Util - -data Unit = Unit -$(deriveJSON A.defaultOptions ''Unit) -$(deriveTypeScript A.defaultOptions ''Unit) - -data OneFieldRecordless = OneFieldRecordless Int -$(deriveJSON A.defaultOptions ''OneFieldRecordless) -$(deriveTypeScript A.defaultOptions ''OneFieldRecordless) - -data OneField = OneField { simpleString :: String } -$(deriveJSON A.defaultOptions ''OneField) -$(deriveTypeScript A.defaultOptions ''OneField) - -data TwoFieldRecordless = TwoFieldRecordless Int String -$(deriveJSON A.defaultOptions ''TwoFieldRecordless) -$(deriveTypeScript A.defaultOptions ''TwoFieldRecordless) - -data TwoField = TwoField { doubleInt :: Int - , doubleString :: String } -$(deriveJSON A.defaultOptions ''TwoField) -$(deriveTypeScript A.defaultOptions ''TwoField) - -data TwoConstructor = Con1 { con1String :: String } - | Con2 { con2String :: String - , con2Int :: Int } -$(deriveJSON A.defaultOptions ''TwoConstructor) -$(deriveTypeScript A.defaultOptions ''TwoConstructor) - -declarations = ((getTypeScriptDeclarations (Proxy :: Proxy Unit)) <> - (getTypeScriptDeclarations (Proxy :: Proxy OneFieldRecordless)) <> - (getTypeScriptDeclarations (Proxy :: Proxy OneField)) <> - (getTypeScriptDeclarations (Proxy :: Proxy TwoFieldRecordless)) <> - (getTypeScriptDeclarations (Proxy :: Proxy TwoField)) <> - (getTypeScriptDeclarations (Proxy :: Proxy TwoConstructor)) - ) - -typesAndValues = [(getTypeScriptType (Proxy :: Proxy Unit) , A.encode Unit) - , (getTypeScriptType (Proxy :: Proxy OneFieldRecordless) , A.encode $ OneFieldRecordless 42) - , (getTypeScriptType (Proxy :: Proxy OneField) , A.encode $ OneField "asdf") - , (getTypeScriptType (Proxy :: Proxy TwoFieldRecordless) , A.encode $ TwoFieldRecordless 42 "asdf") - , (getTypeScriptType (Proxy :: Proxy TwoField) , A.encode $ TwoField 42 "asdf") - , (getTypeScriptType (Proxy :: Proxy TwoConstructor) , A.encode $ Con1 "asdf") - , (getTypeScriptType (Proxy :: Proxy TwoConstructor) , A.encode $ Con2 "asdf" 42) - ] - -tests = describe "TaggedObject with tagSingleConstructors=False" $ do - it "type checks everything with tsc" $ do - testTypeCheckDeclarations declarations typesAndValues +$(testDeclarations "TaggedObject with tagSingleConstructors=False" A.defaultOptions) main = hspec tests diff --git a/test/TaggedObjectTagSingleConstructors.hs b/test/TaggedObjectTagSingleConstructors.hs --- a/test/TaggedObjectTagSingleConstructors.hs +++ b/test/TaggedObjectTagSingleConstructors.hs @@ -1,64 +1,13 @@ -{-# LANGUAGE QuasiQuotes, OverloadedStrings, TemplateHaskell, RecordWildCards, ScopedTypeVariables, NamedFieldPuns #-} +{-# LANGUAGE QuasiQuotes, OverloadedStrings, TemplateHaskell, RecordWildCards, ScopedTypeVariables, NamedFieldPuns, KindSignatures #-} module TaggedObjectTagSingleConstructors (tests) where import Data.Aeson as A import Data.Aeson.TH as A -import Data.Aeson.TypeScript.TH -import Data.Monoid -import Data.Proxy -import Data.String.Interpolate.IsString -import Prelude hiding (Double) -import System.IO.Unsafe (unsafePerformIO) import Test.Hspec +import TestBoilerplate import Util -data Unit = Unit -$(deriveJSON (setTagSingleConstructors A.defaultOptions) ''Unit) -$(deriveTypeScript (setTagSingleConstructors A.defaultOptions) ''Unit) - -data OneFieldRecordless = OneFieldRecordless Int -$(deriveJSON (setTagSingleConstructors A.defaultOptions) ''OneFieldRecordless) -$(deriveTypeScript (setTagSingleConstructors A.defaultOptions) ''OneFieldRecordless) - -data OneField = OneField { simpleString :: String } -$(deriveJSON (setTagSingleConstructors A.defaultOptions) ''OneField) -$(deriveTypeScript (setTagSingleConstructors A.defaultOptions) ''OneField) - -data TwoFieldRecordless = TwoFieldRecordless Int String -$(deriveJSON (setTagSingleConstructors A.defaultOptions) ''TwoFieldRecordless) -$(deriveTypeScript (setTagSingleConstructors A.defaultOptions) ''TwoFieldRecordless) - -data TwoField = TwoField { doubleInt :: Int - , doubleString :: String } -$(deriveJSON (setTagSingleConstructors A.defaultOptions) ''TwoField) -$(deriveTypeScript (setTagSingleConstructors A.defaultOptions) ''TwoField) - -data TwoConstructor = Con1 { con1String :: String } - | Con2 { con2String :: String - , con2Int :: Int } -$(deriveJSON (setTagSingleConstructors A.defaultOptions) ''TwoConstructor) -$(deriveTypeScript (setTagSingleConstructors A.defaultOptions) ''TwoConstructor) - -declarations = ((getTypeScriptDeclarations (Proxy :: Proxy Unit)) <> - (getTypeScriptDeclarations (Proxy :: Proxy OneFieldRecordless)) <> - (getTypeScriptDeclarations (Proxy :: Proxy OneField)) <> - (getTypeScriptDeclarations (Proxy :: Proxy TwoFieldRecordless)) <> - (getTypeScriptDeclarations (Proxy :: Proxy TwoField)) <> - (getTypeScriptDeclarations (Proxy :: Proxy TwoConstructor)) - ) - -typesAndValues = [(getTypeScriptType (Proxy :: Proxy Unit) , A.encode Unit) - , (getTypeScriptType (Proxy :: Proxy OneFieldRecordless) , A.encode $ OneFieldRecordless 42) - , (getTypeScriptType (Proxy :: Proxy OneField) , A.encode $ OneField "asdf") - , (getTypeScriptType (Proxy :: Proxy TwoFieldRecordless) , A.encode $ TwoFieldRecordless 42 "asdf") - , (getTypeScriptType (Proxy :: Proxy TwoField) , A.encode $ TwoField 42 "asdf") - , (getTypeScriptType (Proxy :: Proxy TwoConstructor) , A.encode $ Con1 "asdf") - , (getTypeScriptType (Proxy :: Proxy TwoConstructor) , A.encode $ Con2 "asdf" 42) - ] - -tests = describe "TaggedObject with tagSingleConstructors=True" $ do - it "type checks everything with tsc" $ do - testTypeCheckDeclarations declarations typesAndValues +$(testDeclarations "TaggedObject with tagSingleConstructors=True" (setTagSingleConstructors A.defaultOptions)) main = hspec tests diff --git a/test/TestBoilerplate.hs b/test/TestBoilerplate.hs new file mode 100644 --- /dev/null +++ b/test/TestBoilerplate.hs @@ -0,0 +1,78 @@ +{-# LANGUAGE QuasiQuotes, OverloadedStrings, TemplateHaskell, RecordWildCards, ScopedTypeVariables, NamedFieldPuns, KindSignatures #-} + +module TestBoilerplate where + +import Control.Monad.Writer.Lazy hiding (Product) +import qualified Data.Aeson as A +import Data.Aeson.TH as A +import Data.Aeson.TypeScript.TH +import Data.Proxy +import Language.Haskell.TH +import Test.Hspec +import Util + +data Unit = Unit +data OneFieldRecordless = OneFieldRecordless Int +data OneField = OneField { simpleString :: String } +data TwoFieldRecordless = TwoFieldRecordless Int String +data TwoField = TwoField { doubleInt :: Int, doubleString :: String } +data Hybrid = HybridSimple Int | HybridRecord { hybridString :: String } +data TwoConstructor = Con1 { con1String :: String } | Con2 { con2String :: String, con2Int :: Int } +data Complex a = Nullary | Unary Int | Product String Char a | Record { testOne :: Int, testTwo :: Bool, testThree :: Complex a} deriving Eq + + +testDeclarations :: String -> A.Options -> Q [Dec] +testDeclarations testName aesonOptions = do + decls :: [Dec] <- execWriterT $ do + deriveInstances ''Unit + deriveInstances ''OneFieldRecordless + deriveInstances ''OneField + deriveInstances ''TwoFieldRecordless + deriveInstances ''TwoField + deriveInstances ''Hybrid + deriveInstances ''TwoConstructor + deriveInstances ''Complex + + typesAndValues :: Exp <- [e|[(getTypeScriptType (Proxy :: Proxy Unit), A.encode Unit) + + , (getTypeScriptType (Proxy :: Proxy OneFieldRecordless), A.encode $ OneFieldRecordless 42) + + , (getTypeScriptType (Proxy :: Proxy OneField), A.encode $ OneField "asdf") + + , (getTypeScriptType (Proxy :: Proxy TwoFieldRecordless), A.encode $ TwoFieldRecordless 42 "asdf") + + , (getTypeScriptType (Proxy :: Proxy TwoField), A.encode $ TwoField 42 "asdf") + + , (getTypeScriptType (Proxy :: Proxy TwoConstructor), A.encode $ Con1 "asdf") + , (getTypeScriptType (Proxy :: Proxy TwoConstructor), A.encode $ Con2 "asdf" 42) + + , (getTypeScriptType (Proxy :: Proxy Hybrid), A.encode $ HybridSimple 42) + , (getTypeScriptType (Proxy :: Proxy Hybrid), A.encode $ HybridRecord "asdf") + + , (getTypeScriptType (Proxy :: Proxy (Complex Int)), A.encode (Nullary :: Complex Int)) + , (getTypeScriptType (Proxy :: Proxy (Complex Int)), A.encode (Unary 42 :: Complex Int)) + , (getTypeScriptType (Proxy :: Proxy (Complex Int)), A.encode (Product "asdf" 'g' 42 :: Complex Int)) + , (getTypeScriptType (Proxy :: Proxy (Complex Int)), A.encode ((Record { testOne = 3, testTwo = True, testThree = Product "test" 'A' 123}) :: Complex Int))] + |] + + declarations :: Exp <- [e|getTypeScriptDeclarations (Proxy :: Proxy Unit) + <> getTypeScriptDeclarations (Proxy :: Proxy OneFieldRecordless) + <> getTypeScriptDeclarations (Proxy :: Proxy OneField) + <> getTypeScriptDeclarations (Proxy :: Proxy TwoFieldRecordless) + <> getTypeScriptDeclarations (Proxy :: Proxy TwoField) + <> getTypeScriptDeclarations (Proxy :: Proxy Hybrid) + <> getTypeScriptDeclarations (Proxy :: Proxy TwoConstructor) + <> getTypeScriptDeclarations (Proxy :: Proxy Complex) + |] + + tests <- [d|tests = describe $(return $ LitE $ StringL testName) $ it "type checks everything with tsc" $ testTypeCheckDeclarations $(return declarations) $(return typesAndValues)|] + + return $ decls ++ tests + + where deriveInstances :: Name -> WriterT [Dec] Q () + deriveInstances name = do + writeM $ deriveJSON aesonOptions name + writeM $ deriveTypeScript aesonOptions name + +writeM :: (Monad m) => m w -> WriterT w m () +writeM action = WriterT $ action >>= \w -> return ((), w) diff --git a/test/TwoElemArrayNoTagSingleConstructors.hs b/test/TwoElemArrayNoTagSingleConstructors.hs --- a/test/TwoElemArrayNoTagSingleConstructors.hs +++ b/test/TwoElemArrayNoTagSingleConstructors.hs @@ -1,65 +1,13 @@ -{-# LANGUAGE QuasiQuotes, OverloadedStrings, TemplateHaskell, RecordWildCards, ScopedTypeVariables, NamedFieldPuns #-} +{-# LANGUAGE QuasiQuotes, OverloadedStrings, TemplateHaskell, RecordWildCards, ScopedTypeVariables, NamedFieldPuns, KindSignatures #-} module TwoElemArrayNoTagSingleConstructors (tests) where import Data.Aeson as A import Data.Aeson.TH as A -import Data.Aeson.TypeScript.TH -import Data.Monoid -import Data.Proxy -import Data.String.Interpolate.IsString -import Prelude hiding (Double) -import System.IO.Unsafe (unsafePerformIO) import Test.Hspec +import TestBoilerplate import Util -data Unit = Unit -$(deriveJSON (A.defaultOptions {sumEncoding=TwoElemArray}) ''Unit) -$(deriveTypeScript (A.defaultOptions {sumEncoding=TwoElemArray}) ''Unit) - -data OneFieldRecordless = OneFieldRecordless Int -$(deriveJSON (A.defaultOptions {sumEncoding=TwoElemArray}) ''OneFieldRecordless) -$(deriveTypeScript (A.defaultOptions {sumEncoding=TwoElemArray}) ''OneFieldRecordless) - -data OneField = OneField { simpleString :: String } -$(deriveJSON (A.defaultOptions {sumEncoding=TwoElemArray}) ''OneField) -$(deriveTypeScript (A.defaultOptions {sumEncoding=TwoElemArray}) ''OneField) - -data TwoFieldRecordless = TwoFieldRecordless Int String -$(deriveJSON (A.defaultOptions {sumEncoding=TwoElemArray}) ''TwoFieldRecordless) -$(deriveTypeScript (A.defaultOptions {sumEncoding=TwoElemArray}) ''TwoFieldRecordless) - -data TwoField = TwoField { doubleInt :: Int - , doubleString :: String } -$(deriveJSON (A.defaultOptions {sumEncoding=TwoElemArray}) ''TwoField) -$(deriveTypeScript (A.defaultOptions {sumEncoding=TwoElemArray}) ''TwoField) - -data TwoConstructor = Con1 { con1String :: String } - | Con2 { con2String :: String - , con2Int :: Int } -$(deriveJSON (A.defaultOptions {sumEncoding=TwoElemArray}) ''TwoConstructor) -$(deriveTypeScript (A.defaultOptions {sumEncoding=TwoElemArray}) ''TwoConstructor) - - -declarations = ((getTypeScriptDeclarations (Proxy :: Proxy Unit)) <> - (getTypeScriptDeclarations (Proxy :: Proxy OneFieldRecordless)) <> - (getTypeScriptDeclarations (Proxy :: Proxy OneField)) <> - (getTypeScriptDeclarations (Proxy :: Proxy TwoFieldRecordless)) <> - (getTypeScriptDeclarations (Proxy :: Proxy TwoField)) <> - (getTypeScriptDeclarations (Proxy :: Proxy TwoConstructor)) - ) - -typesAndValues = [(getTypeScriptType (Proxy :: Proxy Unit) , A.encode Unit) - , (getTypeScriptType (Proxy :: Proxy OneFieldRecordless) , A.encode $ OneFieldRecordless 42) - , (getTypeScriptType (Proxy :: Proxy OneField) , A.encode $ OneField "asdf") - , (getTypeScriptType (Proxy :: Proxy TwoFieldRecordless) , A.encode $ TwoFieldRecordless 42 "asdf") - , (getTypeScriptType (Proxy :: Proxy TwoField) , A.encode $ TwoField 42 "asdf") - , (getTypeScriptType (Proxy :: Proxy TwoConstructor) , A.encode $ Con1 "asdf") - , (getTypeScriptType (Proxy :: Proxy TwoConstructor) , A.encode $ Con2 "asdf" 42) - ] - -tests = describe "TwoElemArray with tagSingleConstructors=False" $ do - it "type checks everything with tsc" $ do - testTypeCheckDeclarations declarations typesAndValues +$(testDeclarations "TwoElemArray with tagSingleConstructors=False" (A.defaultOptions {sumEncoding=TwoElemArray})) main = hspec tests diff --git a/test/TwoElemArrayTagSingleConstructors.hs b/test/TwoElemArrayTagSingleConstructors.hs --- a/test/TwoElemArrayTagSingleConstructors.hs +++ b/test/TwoElemArrayTagSingleConstructors.hs @@ -1,65 +1,13 @@ -{-# LANGUAGE QuasiQuotes, OverloadedStrings, TemplateHaskell, RecordWildCards, ScopedTypeVariables, NamedFieldPuns #-} +{-# LANGUAGE QuasiQuotes, OverloadedStrings, TemplateHaskell, RecordWildCards, ScopedTypeVariables, NamedFieldPuns, KindSignatures #-} module TwoElemArrayTagSingleConstructors (tests) where import Data.Aeson as A import Data.Aeson.TH as A -import Data.Aeson.TypeScript.TH -import Data.Monoid -import Data.Proxy -import Data.String.Interpolate.IsString -import Prelude hiding (Double) -import System.IO.Unsafe (unsafePerformIO) import Test.Hspec +import TestBoilerplate import Util -data Unit = Unit -$(deriveJSON (setTagSingleConstructors $ A.defaultOptions {sumEncoding=TwoElemArray}) ''Unit) -$(deriveTypeScript (setTagSingleConstructors $ A.defaultOptions {sumEncoding=TwoElemArray}) ''Unit) - -data OneFieldRecordless = OneFieldRecordless Int -$(deriveJSON (setTagSingleConstructors $ A.defaultOptions {sumEncoding=TwoElemArray}) ''OneFieldRecordless) -$(deriveTypeScript (setTagSingleConstructors $ A.defaultOptions {sumEncoding=TwoElemArray}) ''OneFieldRecordless) - -data OneField = OneField { simpleString :: String } -$(deriveJSON (setTagSingleConstructors $ A.defaultOptions {sumEncoding=TwoElemArray}) ''OneField) -$(deriveTypeScript (setTagSingleConstructors $ A.defaultOptions {sumEncoding=TwoElemArray}) ''OneField) - -data TwoFieldRecordless = TwoFieldRecordless Int String -$(deriveJSON (setTagSingleConstructors $ A.defaultOptions {sumEncoding=TwoElemArray}) ''TwoFieldRecordless) -$(deriveTypeScript (setTagSingleConstructors $ A.defaultOptions {sumEncoding=TwoElemArray}) ''TwoFieldRecordless) - -data TwoField = TwoField { doubleInt :: Int - , doubleString :: String } -$(deriveJSON (setTagSingleConstructors $ A.defaultOptions {sumEncoding=TwoElemArray}) ''TwoField) -$(deriveTypeScript (setTagSingleConstructors $ A.defaultOptions {sumEncoding=TwoElemArray}) ''TwoField) - -data TwoConstructor = Con1 { con1String :: String } - | Con2 { con2String :: String - , con2Int :: Int } -$(deriveJSON (setTagSingleConstructors $ A.defaultOptions {sumEncoding=TwoElemArray}) ''TwoConstructor) -$(deriveTypeScript (setTagSingleConstructors $ A.defaultOptions {sumEncoding=TwoElemArray}) ''TwoConstructor) - - -declarations = ((getTypeScriptDeclarations (Proxy :: Proxy Unit)) <> - (getTypeScriptDeclarations (Proxy :: Proxy OneFieldRecordless)) <> - (getTypeScriptDeclarations (Proxy :: Proxy OneField)) <> - (getTypeScriptDeclarations (Proxy :: Proxy TwoFieldRecordless)) <> - (getTypeScriptDeclarations (Proxy :: Proxy TwoField)) <> - (getTypeScriptDeclarations (Proxy :: Proxy TwoConstructor)) - ) - -typesAndValues = [(getTypeScriptType (Proxy :: Proxy Unit) , A.encode Unit) - , (getTypeScriptType (Proxy :: Proxy OneFieldRecordless) , A.encode $ OneFieldRecordless 42) - , (getTypeScriptType (Proxy :: Proxy OneField) , A.encode $ OneField "asdf") - , (getTypeScriptType (Proxy :: Proxy TwoFieldRecordless) , A.encode $ TwoFieldRecordless 42 "asdf") - , (getTypeScriptType (Proxy :: Proxy TwoField) , A.encode $ TwoField 42 "asdf") - , (getTypeScriptType (Proxy :: Proxy TwoConstructor) , A.encode $ Con1 "asdf") - , (getTypeScriptType (Proxy :: Proxy TwoConstructor) , A.encode $ Con2 "asdf" 42) - ] - -tests = describe "TwoElemArray with tagSingleConstructors=True" $ do - it "type checks everything with tsc" $ do - testTypeCheckDeclarations declarations typesAndValues +$(testDeclarations "TwoElemArray with tagSingleConstructors=True" (setTagSingleConstructors $ A.defaultOptions {sumEncoding=TwoElemArray})) main = hspec tests diff --git a/test/Untagged.hs b/test/Untagged.hs deleted file mode 100644 --- a/test/Untagged.hs +++ /dev/null @@ -1,77 +0,0 @@ -{-# LANGUAGE CPP, QuasiQuotes, OverloadedStrings, TemplateHaskell, RecordWildCards, ScopedTypeVariables, NamedFieldPuns #-} - -module Untagged (tests) where - -import Data.Aeson as A -import Data.Aeson.TH as A -import Data.Aeson.TypeScript.TH -import Data.Monoid -import Data.Proxy -import Data.String.Interpolate.IsString -import Prelude hiding (Double) -import System.IO.Unsafe (unsafePerformIO) -import Test.Hspec -import Util - --- Between Aeson 0.11.3.0 and 1.0.0.0, UntaggedValue was added --- Disable these tests if it's not present -#if MIN_VERSION_aeson(1,0,0) -data Unit = Unit -$(deriveJSON (A.defaultOptions {sumEncoding=UntaggedValue}) ''Unit) -$(deriveTypeScript (A.defaultOptions {sumEncoding=UntaggedValue}) ''Unit) - -data OneFieldRecordless = OneFieldRecordless Int -$(deriveJSON (A.defaultOptions {sumEncoding=UntaggedValue}) ''OneFieldRecordless) -$(deriveTypeScript (A.defaultOptions {sumEncoding=UntaggedValue}) ''OneFieldRecordless) - -data OneField = OneField { simpleString :: String } -$(deriveJSON (A.defaultOptions {sumEncoding=UntaggedValue}) ''OneField) -$(deriveTypeScript (A.defaultOptions {sumEncoding=UntaggedValue}) ''OneField) - -data TwoFieldRecordless = TwoFieldRecordless Int String -$(deriveJSON (A.defaultOptions {sumEncoding=UntaggedValue}) ''TwoFieldRecordless) -$(deriveTypeScript (A.defaultOptions {sumEncoding=UntaggedValue}) ''TwoFieldRecordless) - -data TwoField = TwoField { doubleInt :: Int - , doubleString :: String } -$(deriveJSON (A.defaultOptions {sumEncoding=UntaggedValue}) ''TwoField) -$(deriveTypeScript (A.defaultOptions {sumEncoding=UntaggedValue}) ''TwoField) - -data TwoConstructor = Con1 { con1String :: String } - | Con2 { con2String :: String - , con2Int :: Int } -$(deriveJSON (A.defaultOptions {sumEncoding=UntaggedValue}) ''TwoConstructor) -$(deriveTypeScript (A.defaultOptions {sumEncoding=UntaggedValue}) ''TwoConstructor) - -data MixedNullary = Normal - | Other String deriving (Eq, Ord, Show) -$(deriveJSON (A.defaultOptions { sumEncoding=UntaggedValue }) ''MixedNullary) -$(deriveTypeScript (A.defaultOptions { sumEncoding=UntaggedValue }) ''MixedNullary) - -declarations = ((getTypeScriptDeclarations (Proxy :: Proxy Unit)) <> - (getTypeScriptDeclarations (Proxy :: Proxy OneFieldRecordless)) <> - (getTypeScriptDeclarations (Proxy :: Proxy OneField)) <> - (getTypeScriptDeclarations (Proxy :: Proxy TwoFieldRecordless)) <> - (getTypeScriptDeclarations (Proxy :: Proxy TwoField)) <> - (getTypeScriptDeclarations (Proxy :: Proxy TwoConstructor)) - ) - -typesAndValues = [(getTypeScriptType (Proxy :: Proxy Unit) , A.encode Unit) - , (getTypeScriptType (Proxy :: Proxy OneFieldRecordless) , A.encode $ OneFieldRecordless 42) - , (getTypeScriptType (Proxy :: Proxy OneField) , A.encode $ OneField "asdf") - , (getTypeScriptType (Proxy :: Proxy TwoFieldRecordless) , A.encode $ TwoFieldRecordless 42 "asdf") - , (getTypeScriptType (Proxy :: Proxy TwoField) , A.encode $ TwoField 42 "asdf") - , (getTypeScriptType (Proxy :: Proxy TwoConstructor) , A.encode $ Con1 "asdf") - , (getTypeScriptType (Proxy :: Proxy TwoConstructor) , A.encode $ Con2 "asdf" 42) - ] - -tests = describe "UntaggedValue" $ do - it "type checks everything with tsc" $ do - testTypeCheckDeclarations declarations typesAndValues -#else -tests = describe "UntaggedValue" $ do - it "tests are disabled for this Aeson version" $ do - 2 `shouldBe` 2 -#endif - -main = hspec tests diff --git a/test/UntaggedNoTagSingleConstructors.hs b/test/UntaggedNoTagSingleConstructors.hs new file mode 100644 --- /dev/null +++ b/test/UntaggedNoTagSingleConstructors.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE CPP, QuasiQuotes, OverloadedStrings, TemplateHaskell, RecordWildCards, ScopedTypeVariables, NamedFieldPuns, KindSignatures #-} + +module UntaggedNoTagSingleConstructors (tests) where + +import Data.Aeson as A +import Data.Aeson.TH as A +import Test.Hspec +import TestBoilerplate +import Util + +-- Between Aeson 0.11.3.0 and 1.0.0.0, UntaggedValue was added +-- Disable these tests if it's not present +#if MIN_VERSION_aeson(1,0,0) +$(testDeclarations "UntaggedNoTagSingleConstructors" (A.defaultOptions {sumEncoding=UntaggedValue})) +#else +tests = describe "UntaggedNoTagSingleConstructors" $ it "tests are disabled for this Aeson version" $ 2 `shouldBe` 2 +#endif + +main = hspec tests diff --git a/test/UntaggedTagSingleConstructors.hs b/test/UntaggedTagSingleConstructors.hs new file mode 100644 --- /dev/null +++ b/test/UntaggedTagSingleConstructors.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE CPP, QuasiQuotes, OverloadedStrings, TemplateHaskell, RecordWildCards, ScopedTypeVariables, NamedFieldPuns, KindSignatures #-} + +module UntaggedTagSingleConstructors (tests) where + +import Data.Aeson as A +import Data.Aeson.TH as A +import Test.Hspec +import TestBoilerplate +import Util + +-- Between Aeson 0.11.3.0 and 1.0.0.0, UntaggedValue was added +-- Disable these tests if it's not present +#if MIN_VERSION_aeson(1,0,0) +$(testDeclarations "UntaggedTagSingleConstructors" (setTagSingleConstructors $ A.defaultOptions {sumEncoding=UntaggedValue})) +#else +tests = describe "UntaggedTagSingleConstructors" $ it "tests are disabled for this Aeson version" $ 2 `shouldBe` 2 +#endif + +main = hspec tests diff --git a/test/Util.hs b/test/Util.hs --- a/test/Util.hs +++ b/test/Util.hs @@ -4,12 +4,10 @@ import Control.Monad import Data.Aeson as A +import Data.Aeson.TH as A import Data.Aeson.TypeScript.TH -import Data.Aeson.TypeScript.Types -import Data.Aeson.Types as A import qualified Data.ByteString.Lazy as B import Data.Proxy -import Data.String import Data.String.Interpolate.IsString import qualified Data.Text as T import System.Directory @@ -82,7 +80,7 @@ ensureTSCExists :: IO () -ensureTSCExists = doesFileExist localTSC >>= \exists -> when (not exists) $ void $ do +ensureTSCExists = doesFileExist localTSC >>= \exists -> unless exists $ void $ do cwd <- getCurrentDirectory installScript <- chooseInstallScript