packages feed

aeson-typescript (empty) → 0.1.0.0

raw patch · 20 files changed

+1507/−0 lines, 20 filesdep +aesondep +aeson-typescriptdep +basesetup-changed

Dependencies added: aeson, aeson-typescript, base, bytestring, containers, directory, filepath, hspec, interpolate, mtl, process, tasty, tasty-ant-xml, tasty-hspec, template-haskell, temporary, text, th-abstraction, unordered-containers

Files

+ ChangeLog.md view
@@ -0,0 +1,3 @@+# Changelog for aeson-typescript++## Unreleased changes
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Tom McLaughlin (c) 2017++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Author name here nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,56 @@++# Welcome to `aeson-typescript` [![Hackage](https://img.shields.io/hackage/v/aeson.svg)](https://hackage.haskell.org/package/aeson-typescript) [![Build Status](https://travis-ci.org/bos/aeson.svg)](https://travis-ci.org/codedownio/aeson-typescript)++This library provides a way to generate TypeScript `.d.ts` files that match your existing Aeson `ToJSON` instances.+If you already use Aeson's Template Haskell support to derive your instances, then deriving TypeScript is as simple as++```haskell+$(deriveTypeScript myAesonOptions ''MyType)+```++For example,++```haskell+data D a = Nullary+         | Unary Int+         | Product String Char a+         | Record { testOne   :: Double+                  , testTwo   :: Bool+                  , testThree :: D a+                  } deriving Eq+```++Next we derive the necessary instances.++```haskell+$(deriveTypeScript (defaultOptions {fieldLabelModifier = drop 4, constructorTagModifier = map toLower}) ''D)+```++Now we can use the newly created instances.++```haskell+>>> putStrLn $ formatTSDeclarations $ getTypeScriptDeclaration (Proxy :: Proxy D)++type D<T> = "nullary" | IUnary<T> | IProduct<T> | IRecord<T>;++type IUnary<T> = number;++type IProduct<T> = [string, string, T];++interface IRecord<T> {+  tag: "record";+  One: number;+  Two: boolean;+  Three: D<T>;+}+```++It's important to make sure your JSON and TypeScript are being derived with the same options. For this reason, we+include the convenience 'HasJSONOptions' typeclass, which lets you write the options only once, like this:++```haskell+instance HasJSONOptions MyType where getJSONOptions _ = (defaultOptions {fieldLabelModifier = drop 4})++$(deriveJSON (getJSONOptions (Proxy :: Proxy MyType)) ''MyType)+$(deriveTypeScript (getJSONOptions (Proxy :: Proxy MyType)) ''MyType)+```
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ aeson-typescript.cabal view
@@ -0,0 +1,96 @@+-- This file has been generated from package.yaml by hpack version 0.20.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: b7b8cc9fabc07f52cfa39a27fd83eaaab74f5169d238b970eee90a8f9138f9fa++name:           aeson-typescript+version:        0.1.0.0+synopsis:       Generate TypeScript definition files from your ADTs+description:    Please see the README on Github at <https://github.com/codedownio/aeson-typescript#readme>+category:       Text, Web, JSON+homepage:       https://github.com/codedownio/aeson-typescript#readme+bug-reports:    https://github.com/codedownio/aeson-typescript/issues+author:         Tom McLaughlin+maintainer:     tom@codedown.io+copyright:      2017 CodeDown+license:        BSD3+license-file:   LICENSE+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++source-repository head+  type: git+  location: https://github.com/codedownio/aeson-typescript++library+  hs-source-dirs:+      src+  build-depends:+      aeson+    , base >=4.7 && <5+    , containers+    , interpolate+    , mtl+    , template-haskell+    , text+    , th-abstraction+    , unordered-containers+  exposed-modules:+      Data.Aeson.TypeScript.TH+  other-modules:+      Data.Aeson.TypeScript.Formatting+      Data.Aeson.TypeScript.Instances+      Data.Aeson.TypeScript.Types+      Paths_aeson_typescript+  default-language: Haskell2010++test-suite aeson-typescript-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  hs-source-dirs:+      test+      src+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      aeson+    , aeson-typescript+    , base >=4.7 && <5+    , bytestring+    , containers+    , directory+    , filepath+    , hspec+    , interpolate+    , mtl+    , process+    , tasty+    , tasty-ant-xml+    , tasty-hspec+    , template-haskell+    , temporary+    , text+    , th-abstraction+    , unordered-containers+  other-modules:+      HigherKind+      Misc+      ObjectWithSingleFieldNoTagSingleConstructors+      ObjectWithSingleFieldTagSingleConstructors+      TaggedObjectNoTagSingleConstructors+      TaggedObjectTagSingleConstructors+      TwoElemArrayNoTagSingleConstructors+      TwoElemArrayTagSingleConstructors+      Untagged+      Util+      Data.Aeson.TypeScript.Formatting+      Data.Aeson.TypeScript.Instances+      Data.Aeson.TypeScript.TH+      Data.Aeson.TypeScript.Types+      Paths_aeson_typescript+  default-language: Haskell2010
+ src/Data/Aeson/TypeScript/Formatting.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE QuasiQuotes, OverloadedStrings, TemplateHaskell, RecordWildCards, ScopedTypeVariables, NamedFieldPuns #-}++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 = formatTSDeclarations' defaultFormattingOptions++-- | Format a single TypeScript declaration. This version accepts a FormattingOptions object in case you want more control over the output.+formatTSDeclaration :: FormattingOptions -> TSDeclaration -> String+formatTSDeclaration (FormattingOptions {numIndentSpaces}) (TSTypeAlternatives name genericVariables names) = [i|type #{name}#{getGenericBrackets genericVariables} = #{alternatives};|]+  where alternatives = T.intercalate " | " (fmap T.pack names)+formatTSDeclaration (FormattingOptions {numIndentSpaces}) (TSInterfaceDeclaration interfaceName genericVariables members) = [i|interface #{interfaceName}#{getGenericBrackets genericVariables} {+#{lines}+}|] where lines = T.intercalate "\n" $ fmap T.pack [(replicate numIndentSpaces ' ') <> formatTSField member <> ";"| member <- members]++-- | Format a list of TypeScript declarations into a string, suitable for putting directly into a @.d.ts@ file.+formatTSDeclarations' :: FormattingOptions -> [TSDeclaration] -> String+formatTSDeclarations' options declarations = T.unpack $ T.intercalate "\n\n" (fmap (T.pack . formatTSDeclaration options) declarations)++formatTSField :: TSField -> String+formatTSField (TSField optional name typ) = [i|#{name}#{if optional then "?" else ""}: #{typ}|]++getGenericBrackets :: [String] -> String+getGenericBrackets [] = ""+getGenericBrackets xs = [i|<#{T.intercalate ", " (fmap T.pack xs)}>|]
+ src/Data/Aeson/TypeScript/Instances.hs view
@@ -0,0 +1,84 @@+{-# LANGUAGE QuasiQuotes, OverloadedStrings, TemplateHaskell, RecordWildCards, ScopedTypeVariables, ExistentialQuantification, FlexibleInstances, OverlappingInstances #-}++-- Note: the OverlappingInstances pragma is only here so the overlapping instances in this file+-- will work on older GHCs, like GHC 7.8.4++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"++instance TypeScript T.Text where+  getTypeScriptType _ = "string"++instance TypeScript TL.Text where+  getTypeScriptType _ = "string"++instance TypeScript Integer where+  getTypeScriptType _ = "number"++instance TypeScript Bool where+  getTypeScriptType _ = "boolean"++instance TypeScript Int where+  getTypeScriptDeclarations _ = []+  getTypeScriptType _ = "number"++instance TypeScript Char where+  getTypeScriptType _ = "string"++instance {-# OVERLAPPABLE #-} (TypeScript a) => TypeScript [a] where+  getTypeScriptType _ = (getTypeScriptType (Proxy :: Proxy a)) ++ "[]"++instance {-# OVERLAPPING #-} TypeScript [Char] where+  getTypeScriptType _ = "string"++instance (TypeScript a, TypeScript b) => TypeScript (Either a b) where+  getTypeScriptType _ = [i|Either<#{getTypeScriptType (Proxy :: Proxy a)}, #{getTypeScriptType (Proxy :: Proxy b)}>|]+  getTypeScriptDeclarations _ = [TSTypeAlternatives "Either" ["T1", "T2"] ["Left<T1>", "Right<T2>"]+                               , TSInterfaceDeclaration "Left" ["T"] [TSField False "Left" "T"]+                               , TSInterfaceDeclaration "Right" ["T"] [TSField False "Right" "T"]+                               ]++instance (TypeScript a, TypeScript b) => TypeScript (a, b) where+  getTypeScriptType _ = [i|[#{getTypeScriptType (Proxy :: Proxy a)}, #{getTypeScriptType (Proxy :: Proxy b)}]|]++instance (TypeScript a, TypeScript b, TypeScript c) => TypeScript (a, b, c) where+  getTypeScriptType _ = [i|[#{getTypeScriptType (Proxy :: Proxy a)}, #{getTypeScriptType (Proxy :: Proxy b)}, #{getTypeScriptType (Proxy :: Proxy c)}]|]++instance (TypeScript a, TypeScript b, TypeScript c, TypeScript d) => TypeScript (a, b, c, d) where+  getTypeScriptType _ = [i|[#{getTypeScriptType (Proxy :: Proxy a)}, #{getTypeScriptType (Proxy :: Proxy b)}, #{getTypeScriptType (Proxy :: Proxy c)}, #{getTypeScriptType (Proxy :: Proxy d)}]|]++instance (TypeScript a) => TypeScript (Maybe a) where+  getTypeScriptType _ = getTypeScriptType (Proxy :: Proxy a)+  getTypeScriptOptional _ = True++instance TypeScript A.Value where+  getTypeScriptType _ = "any";++instance (TypeScript a, TypeScript b) => TypeScript (HashMap a b) where+  getTypeScriptType _ = [i|{[k: #{getTypeScriptType (Proxy :: Proxy a)}]: #{getTypeScriptType (Proxy :: Proxy b)}}|]++instance (TypeScript a) => TypeScript (Set a) where+  getTypeScriptType _ = (((getTypeScriptType (Proxy :: Proxy a))) <> "[]");
+ src/Data/Aeson/TypeScript/TH.hs view
@@ -0,0 +1,343 @@+{-# LANGUAGE CPP, QuasiQuotes, OverloadedStrings, TemplateHaskell, RecordWildCards, ScopedTypeVariables, ExistentialQuantification, FlexibleInstances, NamedFieldPuns, MultiWayIf, ViewPatterns #-}++{-|+Module:      Data.Aeson.TypeScript.TH+Copyright:   (c) 2018 Tom McLaughlin+License:     BSD3+Stability:   experimental+Portability: portable++This library provides a way to generate TypeScript @.d.ts@ files that match your existing Aeson 'A.ToJSON' instances.+If you already use Aeson's Template Haskell support to derive your instances, then deriving TypeScript is as simple as++@+$(deriveTypeScript myAesonOptions ''MyType)+@++For example,++@+data D a = Nullary+         | Unary Int+         | Product String Char a+         | Record { testOne   :: Double+                  , testTwo   :: Bool+                  , testThree :: D a+                  } deriving Eq+@++Next we derive the necessary instances.++@+$('deriveTypeScript' ('defaultOptions' {'fieldLabelModifier' = 'drop' 4, 'constructorTagModifier' = map toLower}) ''D)+@++Now we can use the newly created instances.++@+>>> putStrLn $ formatTSDeclarations $ getTypeScriptDeclarations (Proxy :: Proxy D)++type D\<T\> = "nullary" | IUnary\<T\> | IProduct\<T\> | IRecord\<T\>;++type IUnary\<T\> = number;++type IProduct\<T\> = [string, string, T];++interface IRecord\<T\> {+  tag: "record";+  One: number;+  Two: boolean;+  Three: D\<T\>;+}+@++It's important to make sure your JSON and TypeScript are being derived with the same options. For this reason, we+include the convenience 'HasJSONOptions' typeclass, which lets you write the options only once, like this:++@+instance HasJSONOptions MyType where getJSONOptions _ = ('defaultOptions' {'fieldLabelModifier' = 'drop' 4})++$(deriveJSON (getJSONOptions (Proxy :: Proxy MyType)) ''MyType)+$(deriveTypeScript (getJSONOptions (Proxy :: Proxy MyType)) ''MyType)+@++-}++module Data.Aeson.TypeScript.TH (+  deriveTypeScript,++  -- * The main typeclass+  TypeScript(..),++  -- * Formatting declarations+  formatTSDeclarations,+  formatTSDeclaration,+  FormattingOptions(..),++  -- * Convenience tools+  HasJSONOptions(..),++  module Data.Aeson.TypeScript.Instances+  ) where++import Data.Aeson as A+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+import Data.Proxy+import Data.String.Interpolate.IsString+import qualified Data.Text as T+import Language.Haskell.TH hiding (stringE)+import Language.Haskell.TH.Datatype++data T = T+data T1 = T1+data T2 = T2+data T3 = T3+data T4 = T4+data T5 = T5+data T6 = T6+data T7 = T7+data T8 = T8+data T9 = T9+data T10 = T10++instance TypeScript T where+  getTypeScriptType _ = "T"++instance TypeScript T1 where+  getTypeScriptType _ = "T1"++instance TypeScript T2 where+  getTypeScriptType _ = "T2"++instance TypeScript T3 where+  getTypeScriptType _ = "T3"++instance TypeScript T4 where+  getTypeScriptType _ = "T4"++instance TypeScript T5 where+  getTypeScriptType _ = "T5"++instance TypeScript T6 where+  getTypeScriptType _ = "T6"++instance TypeScript T7 where+  getTypeScriptType _ = "T7"++instance TypeScript T8 where+  getTypeScriptType _ = "T8"++instance TypeScript T9 where+  getTypeScriptType _ = "T9"++instance TypeScript T10 where+  getTypeScriptType _ = "T10"+++-- | Generates a 'TypeScript' instance declaration for the given data type or data family instance constructor.+deriveTypeScript :: Options+                 -- ^ Encoding options.+                 -> Name+                 -- ^ Name of the type for which to generate a 'TypeScript' instance declaration.+                 -> Q [Dec]+deriveTypeScript options name = do+  datatypeInfo@(DatatypeInfo {..}) <- reifyDatatype name++  let getFreeVariableName (SigT (VarT name) kind) = Just name+      getFreeVariableName typ = Nothing++  let templateVarsToUse = case length datatypeVars of+        1 -> [ConT ''T]+        n -> take (length datatypeVars) [ConT ''T1, ConT ''T2, ConT ''T3, ConT ''T4, ConT ''T5, ConT ''T6, ConT ''T7, ConT ''T8, ConT ''T9, ConT ''T10]++  let subMap = M.fromList $ zip (catMaybes $ fmap getFreeVariableName datatypeVars) templateVarsToUse+  let fullyQualifiedDatatypeInfo = (datatypeInfo {datatypeVars = templateVarsToUse+                                                 , datatypeCons = fmap (applySubstitution subMap) datatypeCons})+  getTypeFn <- getTypeExpression fullyQualifiedDatatypeInfo >>= \expr -> return $ FunD 'getTypeScriptType [Clause [WildP] (NormalB expr) []]+  getDeclarationFn <- getDeclarationFunctionBody options name fullyQualifiedDatatypeInfo+  let fullyGenericInstance = mkInstance [] (AppT (ConT ''TypeScript) (ConT name)) [getTypeFn, getDeclarationFn]++  otherInstances <- case length datatypeVars > 0 of+    True -> do+      otherGetTypeFn <- getTypeExpression datatypeInfo >>= \expr -> return $ FunD 'getTypeScriptType [Clause [WildP] (NormalB expr) []]+      return [mkInstance (fmap getDatatypePredicate datatypeVars) (AppT (ConT ''TypeScript) (foldl (\x y -> AppT x y) (ConT name) datatypeVars)) [otherGetTypeFn]]+    False -> return []++  return $ fullyGenericInstance : otherInstances++getDeclarationFunctionBody :: Options -> p -> DatatypeInfo -> Q Dec+getDeclarationFunctionBody options _name datatypeInfo@(DatatypeInfo {..}) = do+  -- If name is higher-kinded, add generic variables to the type and interface declarations+  let genericVariables :: [String] = if | length datatypeVars == 1 -> ["T"]+                                        | 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+    let interfaceDeclarations = catMaybes $ fmap snd interfaceNamesAndDeclarations++    let typeDeclaration = applyToArgsE (ConE 'TSTypeAlternatives) [stringE $ getTypeName datatypeName, genericVariablesExp, ListE interfaceNames]++    return $ NormalB $ ListE (typeDeclaration : interfaceDeclarations)++  return $ FunD 'getTypeScriptDeclarations [Clause [WildP] declarationFnBody []]+++-- | 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)+  where+    -- * 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++    -- * 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)]++                            tagField = case sumEncoding options of+                              TaggedObject tagFieldName contentsFieldName | shouldTag -> [(AppE (AppE (AppE (ConE 'TSField) (ConE 'False))+                                                                                                 (stringE tagFieldName))+                                                                                           (stringE $ [i|"#{constructorNameToUse}"|]))]+                              _ -> []++    shouldTag = (((length datatypeCons) > 1) || (getTagSingleConstructors options))+    constructorNameToUse = (constructorTagModifier options) $ lastNameComponent' constructorName+    contentsTupleType = getTupleType constructorFields+++-- | Helper for handleConstructor+getTSFields :: [(String, Type)] -> [Exp]+getTSFields namesAndTypes = [(AppE (AppE (AppE (ConE 'TSField) (getOptionalAsBoolExp typ))+                                     (stringE nameString))+                               (getTypeAsStringExp typ))+                            | (nameString, typ) <- namesAndTypes]++-- | Helper for handleConstructor+assembleInterfaceDeclaration options constructorName genericVariables members = AppE (AppE (AppE (ConE 'TSInterfaceDeclaration) constructorNameExp) genericVariablesExp) members where+  constructorNameExp = stringE $ getInterfaceName constructorName+  genericVariablesExp = (ListE [stringE x | x <- genericVariables])+++-- * Getting type expression++-- | Get an expression to be used for getTypeScriptType.+-- For datatypes of kind * this is easy, since we can just evaluate the string literal in TH.+-- For higher-kinded types, we need to make an expression which evaluates the template types and fills it in.+getTypeExpression :: DatatypeInfo -> Q Exp+getTypeExpression (DatatypeInfo {datatypeVars=[], ..}) = return $ stringE $ getTypeName datatypeName+getTypeExpression (DatatypeInfo {datatypeVars=vars, ..}) = do+  let baseName = stringE $ getTypeName datatypeName+  let typeNames = ListE [getTypeAsStringExp typ | typ <- vars]+  let headType = AppE (VarE 'head) typeNames+  let tailType = AppE (VarE 'tail) typeNames+  let comma = stringE ", "+  x <- newName "x"+  let tailsWithCommas = AppE (VarE 'mconcat) (CompE [BindS (VarP x) tailType, NoBindS (AppE (AppE (VarE 'mappend) comma) (VarE x))])+  let brackets = AppE (VarE 'mconcat) (ListE [stringE "<", headType, tailsWithCommas, stringE ">"])++  return $ (AppE (AppE (VarE 'mappend) baseName) brackets)++-- * Util stuff++lastNameComponent :: String -> String+lastNameComponent x = T.unpack $ last $ T.splitOn "." (T.pack x)++lastNameComponent' :: Name -> String+lastNameComponent' = lastNameComponent . show++getInterfaceName :: Name -> String+getInterfaceName x = "I" <> (lastNameComponent' x)++getTypeName :: Name -> String+getTypeName x = lastNameComponent $ show x++allConstructorsAreNullary :: [ConstructorInfo] -> Bool+allConstructorsAreNullary constructors = and $ fmap isConstructorNullary constructors++isConstructorNullary :: ConstructorInfo -> Bool+isConstructorNullary (ConstructorInfo {constructorVariant, constructorFields}) = (constructorVariant == NormalConstructor) && (constructorFields == [])++-- In Template Haskell 2.10.0.0 and later, Pred is just a synonm for Type+-- In earlier versions, it has constructors+getDatatypePredicate :: Type -> Pred+#if MIN_VERSION_template_haskell(2,10,0)+getDatatypePredicate typ = AppT (ConT ''TypeScript) typ+#else+getDatatypePredicate typ = ClassP ''TypeScript [typ]+#endif++getTypeAsStringExp :: Type -> Exp+getTypeAsStringExp typ = AppE (VarE 'getTypeScriptType) (SigE (ConE 'Proxy) (AppT (ConT ''Proxy) typ))++getOptionalAsBoolExp :: Type -> Exp+getOptionalAsBoolExp typ = AppE (VarE 'getTypeScriptOptional) (SigE (ConE 'Proxy) (AppT (ConT ''Proxy) typ))++isTaggedObject (sumEncoding -> TaggedObject _ _) = True+isTaggedObject _ = False++-- | Get the type of a tuple of constructor fields, as when we're packing a record-less constructor into a list+getTupleType constructorFields = case length constructorFields of+  0 -> AppT ListT (ConT ''())+  1 -> head constructorFields+  x -> applyToArgsT (ConT $ tupleTypeName x) constructorFields++-- | Helper to apply a type constructor to a list of type args+applyToArgsT :: Type -> [Type] -> Type+applyToArgsT constructor [] = constructor+applyToArgsT constructor (x:xs) = applyToArgsT (AppT constructor x) xs++-- | Helper to apply a function a list of args+applyToArgsE :: Exp -> [Exp] -> Exp+applyToArgsE f [] = f+applyToArgsE f (x:xs) = applyToArgsE (AppE f x) xs++stringE = LitE . StringL++-- Between Template Haskell 2.10 and 2.11, InstanceD got an additional argument+#if MIN_VERSION_template_haskell(2,11,0)+mkInstance context typ decs = InstanceD Nothing context typ decs+#else+mkInstance context typ decs = InstanceD context typ decs+#endif++-- Between Aeson 1.1.2.0 and 1.2.0.0, tagSingleConstructors was added+getTagSingleConstructors :: Options -> Bool+#if MIN_VERSION_aeson(1,2,0)+getTagSingleConstructors options = tagSingleConstructors options+#else+getTagSingleConstructors options = False+#endif++-- Older versions of Aeson don't have an Eq instance for SumEncoding so we do this+isObjectWithSingleField ObjectWithSingleField = True+isObjectWithSingleField _ = False++-- Older versions of Aeson don't have an Eq instance for SumEncoding so we do this+isTwoElemArray TwoElemArray = True+isTwoElemArray _ = False
+ src/Data/Aeson/TypeScript/Types.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE QuasiQuotes, OverloadedStrings, TemplateHaskell, RecordWildCards, ScopedTypeVariables, ExistentialQuantification, PolyKinds #-}++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 Data.Data+import Data.Monoid+import Data.Proxy+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.+class TypeScript a where+  getTypeScriptDeclarations :: Proxy a -> [TSDeclaration]+  -- ^ Get the declaration(s) needed for this type.+  getTypeScriptDeclarations _ = []++  getTypeScriptType :: Proxy a -> String+  -- ^ Get the type as a string.++  getTypeScriptOptional :: Proxy a -> Bool+  -- ^ Get a flag representing whether this type is optional.+  getTypeScriptOptional _ = False++data TSDeclaration = TSInterfaceDeclaration { interfaceName :: String+                                            , interfaceGenericVariables :: [String]+                                            , interfaceMembers :: [TSField] }+                   | TSTypeAlternatives { typeName :: String+                                        , typeGenericVariables :: [String]+                                        , alternativeTypes :: [String]}+  deriving (Show, Eq)++data TSField = TSField { fieldOptional :: Bool+                       , fieldName :: String+                       , fieldType :: String } deriving (Show, Eq)++newtype TSString a = TSString { unpackTSString :: String } deriving Show++instance IsString (TSString a) where+  fromString x = TSString x++-- * Formatting options++data FormattingOptions = FormattingOptions {+  numIndentSpaces :: Int+  -- ^ How many spaces to indent TypeScript blocks+  }++defaultFormattingOptions = FormattingOptions 2++-- | 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/HigherKind.hs view
@@ -0,0 +1,100 @@+{-# LANGUAGE QuasiQuotes, OverloadedStrings, TemplateHaskell, RecordWildCards, ScopedTypeVariables, NamedFieldPuns, KindSignatures #-}++module HigherKind (tests) where++import Data.Aeson as A+import Data.Aeson.TH as A+import Data.Aeson.TypeScript.TH+import Data.Aeson.TypeScript.Types+import Data.Monoid+import Data.Proxy+import Data.String.Interpolate.IsString+import Prelude hiding (Double)+import System.IO.Unsafe (unsafePerformIO)+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)+import Test.Tasty.Runners+import Util+++data HigherKind a = HigherKind { higherKindList :: [a] }+$(deriveTypeScript A.defaultOptions ''HigherKind)+$(deriveJSON A.defaultOptions ''HigherKind)++data Foo = Foo { fooString :: String+               , fooHigherKindReference :: HigherKind String }+$(deriveTypeScript A.defaultOptions ''Foo)++data DoubleHigherKind a b = DoubleHigherKind { someList :: [b]+                                             , higherKindThing :: HigherKind a }+$(deriveTypeScript A.defaultOptions ''DoubleHigherKind)+$(deriveJSON A.defaultOptions ''DoubleHigherKind)++data HigherKindWithUnary a = Unary Int+$(deriveTypeScript A.defaultOptions ''HigherKindWithUnary)+$(deriveJSON A.defaultOptions ''HigherKindWithUnary)+++tests = unsafePerformIO $ testSpec "Higher kinds" $ do+  describe "Kind * -> *" $ do+    it [i|makes the declaration and types correctly|] $ do+      (getTypeScriptDeclarations (Proxy :: Proxy HigherKind)) `shouldBe` ([+        TSTypeAlternatives "HigherKind" ["T"] ["IHigherKind<T>"],+        TSInterfaceDeclaration "IHigherKind" ["T"] [TSField False "higherKindList" "T[]"]+        ])++      (getTypeScriptType (Proxy :: Proxy (HigherKind Int))) `shouldBe` "HigherKind<number>"+      (getTypeScriptType (Proxy :: Proxy (HigherKind String))) `shouldBe` "HigherKind<string>"++    it [i|works when referenced in another type|] $ do+      (getTypeScriptDeclarations (Proxy :: Proxy Foo)) `shouldBe` ([+        TSTypeAlternatives "Foo" [] ["IFoo"],+        TSInterfaceDeclaration "IFoo" [] [TSField False "fooString" "string"+                                         , TSField False "fooHigherKindReference" "HigherKind<string>"]+        ])++    it [i|works with an interface inside|] $ do+      (getTypeScriptDeclarations (Proxy :: Proxy HigherKindWithUnary)) `shouldBe` ([+        TSTypeAlternatives "HigherKindWithUnary" ["T"] ["IUnary<T>"],+        TSTypeAlternatives "IUnary" ["T"] ["number"]+        ])++  describe "Kind * -> * -> *" $ do+    it [i|makes the declaration and type correctly|] $ do+      (getTypeScriptDeclarations (Proxy :: Proxy DoubleHigherKind)) `shouldBe` ([+        TSTypeAlternatives "DoubleHigherKind" ["T1","T2"] ["IDoubleHigherKind<T1, T2>"],+        TSInterfaceDeclaration "IDoubleHigherKind" ["T1","T2"] [TSField False "someList" "T2[]"+                                                               , TSField False "higherKindThing" "HigherKind<T1>"]+        ])++      (getTypeScriptType (Proxy :: Proxy (DoubleHigherKind Int String))) `shouldBe` "DoubleHigherKind<number, string>"+      (getTypeScriptType (Proxy :: Proxy (DoubleHigherKind String Int))) `shouldBe` "DoubleHigherKind<string, number>"++  describe "TSC compiler checks" $ do+    it "type checks everything with tsc" $ do+      let declarations = ((getTypeScriptDeclarations (Proxy :: Proxy HigherKind)) <>+                          (getTypeScriptDeclarations (Proxy :: Proxy DoubleHigherKind)) <>+                          (getTypeScriptDeclarations (Proxy :: Proxy HigherKindWithUnary))+                         )++      let typesAndValues = [(getTypeScriptType (Proxy :: Proxy (HigherKind Int)) , A.encode (HigherKind [42 :: Int]))+                           , (getTypeScriptType (Proxy :: Proxy (HigherKind String)) , A.encode (HigherKind ["asdf" :: String]))++                           , (getTypeScriptType (Proxy :: Proxy (DoubleHigherKind String Int)) , A.encode (DoubleHigherKind [42 :: Int] (HigherKind ["asdf" :: String])))+                           , (getTypeScriptType (Proxy :: Proxy (DoubleHigherKind Int String)) , A.encode (DoubleHigherKind ["asdf" :: String] (HigherKind [42 :: Int])))++                           , (getTypeScriptType (Proxy :: Proxy (HigherKindWithUnary String)) , A.encode ((Unary 42) :: HigherKindWithUnary String))+                           ]++      testTypeCheckDeclarations declarations typesAndValues+++main = defaultMainWithIngredients defaultIngredients tests+++main' = putStrLn $ formatTSDeclarations (+   (getTypeScriptDeclarations (Proxy :: Proxy HigherKind)) <>+   (getTypeScriptDeclarations (Proxy :: Proxy DoubleHigherKind)) <>+   (getTypeScriptDeclarations (Proxy :: Proxy HigherKindWithUnary))+  )
+ test/Misc.hs view
@@ -0,0 +1,77 @@+{-# 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 Test.Tasty+import Test.Tasty.Hspec (testSpec)+import Test.Tasty.Runners++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)
+ test/ObjectWithSingleFieldNoTagSingleConstructors.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE QuasiQuotes, OverloadedStrings, TemplateHaskell, RecordWildCards, ScopedTypeVariables, NamedFieldPuns #-}++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 Test.Tasty+import Test.Tasty.Hspec (testSpec)+import Test.Tasty.Runners+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 = unsafePerformIO $ testSpec "ObjectWithSingleField with tagSingleConstructors=False" $ do+  it "type checks everything with tsc" $ do+    testTypeCheckDeclarations declarations typesAndValues+++main = defaultMainWithIngredients defaultIngredients tests
+ test/ObjectWithSingleFieldTagSingleConstructors.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE QuasiQuotes, OverloadedStrings, TemplateHaskell, RecordWildCards, ScopedTypeVariables, NamedFieldPuns #-}++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 Test.Tasty+import Test.Tasty.Hspec (testSpec)+import Test.Tasty.Runners+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 = unsafePerformIO $ testSpec "ObjectWithSingleField with tagSingleConstructors=True" $ do+  it "type checks everything with tsc" $ do+    testTypeCheckDeclarations declarations typesAndValues++main = defaultMainWithIngredients defaultIngredients tests
+ test/Spec.hs view
@@ -0,0 +1,25 @@++module Main where++import Test.Tasty++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++allTests :: TestTree+allTests = testGroup "All unit tests" [ObjectWithSingleFieldTagSingleConstructors.tests+                                      , ObjectWithSingleFieldNoTagSingleConstructors.tests+                                      , TaggedObjectTagSingleConstructors.tests+                                      , TaggedObjectNoTagSingleConstructors.tests+                                      , TwoElemArrayTagSingleConstructors.tests+                                      , TwoElemArrayNoTagSingleConstructors.tests+                                      , Untagged.tests+                                      , HigherKind.tests]++main = defaultMainWithIngredients defaultIngredients $ allTests
+ test/TaggedObjectNoTagSingleConstructors.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE QuasiQuotes, OverloadedStrings, TemplateHaskell, RecordWildCards, ScopedTypeVariables, NamedFieldPuns #-}++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 Test.Tasty+import Test.Tasty.Hspec (testSpec)+import Test.Tasty.Runners+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 = unsafePerformIO $ testSpec "TaggedObject with tagSingleConstructors=False" $ do+  it "type checks everything with tsc" $ do+    testTypeCheckDeclarations declarations typesAndValues++main = defaultMainWithIngredients defaultIngredients tests
+ test/TaggedObjectTagSingleConstructors.hs view
@@ -0,0 +1,67 @@+{-# LANGUAGE QuasiQuotes, OverloadedStrings, TemplateHaskell, RecordWildCards, ScopedTypeVariables, NamedFieldPuns #-}++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 Test.Tasty+import Test.Tasty.Hspec (testSpec)+import Test.Tasty.Runners+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 = unsafePerformIO $ testSpec "TaggedObject with tagSingleConstructors=True" $ do+  it "type checks everything with tsc" $ do+    testTypeCheckDeclarations declarations typesAndValues++main = defaultMainWithIngredients defaultIngredients tests
+ test/TwoElemArrayNoTagSingleConstructors.hs view
@@ -0,0 +1,68 @@+{-# LANGUAGE QuasiQuotes, OverloadedStrings, TemplateHaskell, RecordWildCards, ScopedTypeVariables, NamedFieldPuns #-}++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 Test.Tasty+import Test.Tasty.Hspec (testSpec)+import Test.Tasty.Runners+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 = unsafePerformIO $ testSpec "TwoElemArray with tagSingleConstructors=False" $ do+  it "type checks everything with tsc" $ do+    testTypeCheckDeclarations declarations typesAndValues++main = defaultMainWithIngredients defaultIngredients tests
+ test/TwoElemArrayTagSingleConstructors.hs view
@@ -0,0 +1,68 @@+{-# LANGUAGE QuasiQuotes, OverloadedStrings, TemplateHaskell, RecordWildCards, ScopedTypeVariables, NamedFieldPuns #-}++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 Test.Tasty+import Test.Tasty.Hspec (testSpec)+import Test.Tasty.Runners+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 = unsafePerformIO $ testSpec "TwoElemArray with tagSingleConstructors=True" $ do+  it "type checks everything with tsc" $ do+    testTypeCheckDeclarations declarations typesAndValues++main = defaultMainWithIngredients defaultIngredients tests
+ test/Untagged.hs view
@@ -0,0 +1,80 @@+{-# 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 Test.Tasty+import Test.Tasty.Hspec (testSpec)+import Test.Tasty.Runners+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 = unsafePerformIO $ testSpec "UntaggedValue" $ do+  it "type checks everything with tsc" $ do+    testTypeCheckDeclarations declarations typesAndValues+#else+tests = unsafePerformIO $ testSpec "UntaggedValue" $ do+  it "tests are disabled for this Aeson version" $ do+    2 `shouldBe` 2+#endif++main = defaultMainWithIngredients defaultIngredients tests
+ test/Util.hs view
@@ -0,0 +1,98 @@+{-# LANGUAGE CPP, QuasiQuotes, OverloadedStrings, TemplateHaskell, RecordWildCards, ScopedTypeVariables, NamedFieldPuns #-}++module Util where++import Control.Monad+import Data.Aeson 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+import System.Environment+import System.Exit+import System.FilePath+import System.IO.Temp+import System.Process++localTSC = "test_assets/node_modules/.bin/tsc"++isCI :: IO Bool+isCI = lookupEnv "CI" >>= (return . (== (Just "true")))++getTSC :: IO FilePath+getTSC = do+  isCI <- isCI+  case isCI of+    True -> do+      putStrLn "Using global TSC"+      return "tsc" -- Assume it's set up on the path+    False -> do+      putStrLn "Using local TSC"+      ensureTSCExists+      return localTSC++testTypeCheck :: forall a. (TypeScript a, ToJSON a) => a -> IO ()+testTypeCheck obj = withSystemTempDirectory "typescript_test" $ \folder -> do+  let tsFile = folder </> "test.ts"++  writeFile tsFile [i|+#{formatTSDeclarations tsDeclarations}++let x: #{tsType} = #{A.encode obj};+|]++  -- "--diagnostics", "--listFiles"+  tsc <- getTSC+  readProcess tsc ["--noEmit", "--skipLibCheck", "--traceResolution", "--noResolve", tsFile] ""++  return ()+  where tsDeclarations :: [TSDeclaration] = getTypeScriptDeclarations (Proxy :: Proxy a)+        tsType :: String = getTypeScriptType (Proxy :: Proxy a)+++getTSFile tsDeclarations typesAndVals = [i|+#{formatTSDeclarations tsDeclarations}++#{T.unlines typeLines}+|]+  where typeLines = [[i|let x#{index}: #{typ} = #{val};|] | (index, (typ, val)) <- zip [1..] typesAndVals]+++testTypeCheckDeclarations :: [TSDeclaration] -> [(String, B.ByteString)] -> IO ()+testTypeCheckDeclarations tsDeclarations typesAndVals = withSystemTempDirectory "typescript_test" $ \folder -> do+  let tsFile = folder </> "test.ts"++  let contents = getTSFile tsDeclarations typesAndVals++  writeFile tsFile contents++  tsc <- getTSC+  (code, output, err) <- readProcessWithExitCode tsc ["--noEmit", "--skipLibCheck", "--traceResolution", "--noResolve", tsFile] ""++  when (code /= ExitSuccess) $ do+    putStrLn [i|TSC check failed. File contents were\n\n#{contents}|]+    error [i|TSC check failed: #{output}|]++  return ()+++ensureTSCExists :: IO ()+ensureTSCExists = doesFileExist localTSC >>= \exists -> when (not exists) $ void $ do+  cwd <- getCurrentDirectory+  putStrLn [i|Invoking yarn to install tsc compiler (make sure yarn is installed). CWD is #{cwd}|]+  (exitCode, stdout, stderr) <- readProcessWithExitCode "test_assets/yarn_install.sh" [] ""+  when (exitCode /= ExitSuccess) $ putStrLn [i|Error installing yarn: '#{stderr}', '#{stdout}'|]+++-- Between Aeson 1.1.2.0 and 1.2.0.0, tagSingleConstructors was added+setTagSingleConstructors :: Options -> Options+#if MIN_VERSION_aeson(1,2,0)+setTagSingleConstructors options = options {tagSingleConstructors=True}+#else+setTagSingleConstructors = id+#endif