diff --git a/.envrc b/.envrc new file mode 100644 index 0000000..ac5cf17 --- /dev/null +++ b/.envrc @@ -0,0 +1,6 @@ + +if ! has nix_direnv_version || ! nix_direnv_version 2.2.0; then + source_url "https://raw.githubusercontent.com/nix-community/nix-direnv/2.2.0/direnvrc" "sha256-5EwyKnkJNQeXrRkYbwwRBcXbibosCJqyIUuz9Xq+LRc=" +fi + +use_flake diff --git a/.github/workflows/aeson-typescript.yml b/.github/workflows/aeson-typescript.yml index 669806a..7cd9973 100644 --- a/.github/workflows/aeson-typescript.yml +++ b/.github/workflows/aeson-typescript.yml @@ -13,20 +13,26 @@ jobs: matrix: os: [ubuntu-latest, macOS-latest] ghc: - - "8.6.5" - - "8.8.4" - "8.10.7" - "9.0.2" - - "9.2.6" - - "9.4.4" - # exclude: - # - os: macOS-latest - # ghc: 8.8.3 + - "9.2.8" + - "9.4.8" + - "9.6.7" + - "9.8.4" + - "9.10.2" + - "9.12.2" + exclude: + # These don't work on GitHub CI anymore because they need llvm@13, which became + # disabled on 12/31/2024 + - os: macOS-latest + ghc: 8.10.7 + - os: macOS-latest + ghc: 9.0.2 steps: - uses: actions/checkout@v2 - - uses: haskell/actions/setup@v2 + - uses: haskell-actions/setup@v2 id: setup-haskell-cabal name: Setup Haskell with: @@ -37,16 +43,15 @@ jobs: run: | cabal freeze - - uses: actions/cache@v1 + - uses: actions/cache@v3 name: Cache ~/.cabal/store with: path: ${{ steps.setup-haskell-cabal.outputs.cabal-store }} key: ${{ runner.os }}-${{ matrix.ghc }}-${{ hashFiles('cabal.project.freeze') }} - # Install TSC - - uses: actions/setup-node@v2 + - uses: actions/setup-node@v3 with: - node-version: '12' + node-version: '16' - name: Install TSC run: | npm install -g typescript @@ -66,40 +71,51 @@ jobs: strategy: fail-fast: false matrix: - ghc: - - "8.8.4" - - "8.10.7" - - "9.0.2" - - "9.2.6" - - "9.4.4" + include: + - ghc: "8.10.7" + yaml: "stack-8.10.7.yaml" + - ghc: "9.0.2" + yaml: "stack-9.0.2.yaml" + - ghc: "9.2.8" + yaml: "stack-9.2.8.yaml" + - ghc: "9.4.8" + yaml: "stack-9.4.8.yaml" + - ghc: "9.6.7" + yaml: "stack-9.6.7.yaml" + - ghc: "9.8.4" + yaml: "stack-9.8.4.yaml" + - ghc: "9.10.2" + yaml: "stack-9.10.2.yaml" + - ghc: "9.12.2" + yaml: "stack-9.12.2.yaml" steps: - - uses: actions/checkout@v2 + - uses: actions/checkout@v3 - - uses: haskell/actions/setup@v2 + - uses: haskell-actions/setup@v2 name: Setup Haskell Stack with: ghc-version: ${{ matrix.ghc }} + enable-stack: true stack-version: "latest" - - uses: actions/cache@v1 + - uses: actions/cache@v3 name: Cache ~/.stack with: path: ~/.stack - key: ${{ runner.os }}-${{ matrix.ghc }}-stack + key: ${{ runner.os }}-${{ matrix.ghc }}-${{ matrix.yaml }} - # Install TSC - - uses: actions/setup-node@v2 + - uses: actions/setup-node@v3 with: - node-version: '12' + node-version: '16' - name: Install TSC run: | npm install -g typescript - name: Build run: | - stack build --system-ghc --test --bench --no-run-tests --no-run-benchmarks + stack build --stack-yaml ${{matrix.yaml}} --system-ghc --test --bench --no-run-tests --no-run-benchmarks - name: Test run: | - stack test --system-ghc + stack test --stack-yaml ${{matrix.yaml}} --system-ghc diff --git a/.gitignore b/.gitignore index 938bf2c..346524a 100644 --- a/.gitignore +++ b/.gitignore @@ -3,3 +3,7 @@ dist-newstyle *.hie dev/ + +.direnv + +result diff --git a/CHANGELOG.md b/CHANGELOG.md index f0610c1..aabd8b1 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,11 +1,39 @@ # Change log +## Unreleased -## (unreleased) +* Remove question mark in Data.Map instance + +## 0.6.4.0 + +* Fix type for maps with non-string keys (#46, fixes #28, thanks @tfausak!) + +## 0.6.3.0 + +* GHC 9.8 support + +## 0.6.2.0 + +* Expose generic type constructors `T4` through `T10`. (We only exposed `T`, `T1`, `T2`, and `T3` before.) + +## 0.6.1.0 + +* Fix a bug which caused enum formatting mode to turn off when multiple declarations were provided (#41) +* Fix some mismatch issues where an enum value doesn't match the desired string. + +## 0.6.0.0 + +* New word instances: Word, Word16, Word32, Word64 +* New instances from Data.Functor: Compose, Const, Identity, Product + +## 0.5.0.0 * [#35](https://github.com/codedownio/aeson-typescript/pull/35) * Add `Data.Aeson.TypeScript.LegalName` module for checking whether a name is a legal JavaScript name or not. * The `defaultFormatter` will `error` if the name contains illegal characters. +* Be able to transfer Haddock comments to emitted TypeScript (requires GHC >= 9.2 and `-haddock` flag) +* Add support for @no-emit-typescript in Haddocks for constructors and record fields (requires GHC >= 9.2 and `-haddock` flag) +* Support GHC 9.6.1 ## 0.4.2.0 diff --git a/README.md b/README.md index 4cdf469..227be17 100644 --- a/README.md +++ b/README.md @@ -114,6 +114,6 @@ Now you can generate the types by running `stack runhaskell tsdef/Main.hs > type # See also -If you want a much more opinionated web framework for generating APIs, check out [servant](http://haskell-servant.readthedocs.io/en/stable/). (Although it doesn't seem to support TypeScript client generation at the moment.) +If you want a more opinionated web framework for generating APIs, check out [servant](http://haskell-servant.readthedocs.io/en/stable/). If you use Servant, you may enjoy [servant-typescript](https://github.com/codedownio/servant-typescript), which is based on `aeson-typescript`! This companion package also has the advantage of magically collecting all the types used in your API, so you don't have to list them out manually. For another very powerful framework that can generate TypeScript client code based on an API specification, see [Swagger/OpenAPI](https://github.com/swagger-api/swagger-codegen). diff --git a/aeson-typescript.cabal b/aeson-typescript.cabal index 2837766..2387dd8 100644 --- a/aeson-typescript.cabal +++ b/aeson-typescript.cabal @@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.1. +-- This file has been generated from package.yaml by hpack version 0.38.0. -- -- see: https://github.com/sol/hpack name: aeson-typescript -version: 0.4.2.0 +version: 0.6.4.0 synopsis: Generate TypeScript definition files from your ADTs description: Please see the README on Github at category: Text, Web, JSON @@ -18,7 +18,13 @@ license: BSD3 license-file: LICENSE build-type: Simple tested-with: - GHC == 9.0.1, GHC == 8.10.4, GHC == 8.10.3, GHC == 8.8.4, GHC == 8.8.3 + GHC == 9.6.1 + , GHC == 9.4.4 + , GHC == 9.2.7 + , GHC == 9.0.2 + , GHC == 8.10.7 + , GHC == 8.8.4 + , GHC == 8.6.5 extra-source-files: README.md CHANGELOG.md @@ -40,6 +46,7 @@ library other-modules: Data.Aeson.TypeScript.Formatting Data.Aeson.TypeScript.Instances + Data.Aeson.TypeScript.Instances.TupleGen Data.Aeson.TypeScript.Lookup Data.Aeson.TypeScript.Transform Data.Aeson.TypeScript.TypeManipulation @@ -48,9 +55,20 @@ library Paths_aeson_typescript hs-source-dirs: src + default-extensions: + LambdaCase + MultiWayIf + NamedFieldPuns + OverloadedStrings + QuasiQuotes + RecordWildCards + ScopedTypeVariables + TupleSections + ViewPatterns build-depends: aeson , base >=4.7 && <5 + , bytestring , containers , mtl , string-interpolate @@ -72,6 +90,7 @@ test-suite aeson-typescript-tests GetDoc HigherKind LegalNameSpec + MaybeTuples NoOmitNothingFields ObjectWithSingleFieldNoTagSingleConstructors ObjectWithSingleFieldTagSingleConstructors @@ -89,6 +108,7 @@ test-suite aeson-typescript-tests Util.Aeson Data.Aeson.TypeScript.Formatting Data.Aeson.TypeScript.Instances + Data.Aeson.TypeScript.Instances.TupleGen Data.Aeson.TypeScript.Internal Data.Aeson.TypeScript.LegalName Data.Aeson.TypeScript.Lookup @@ -103,14 +123,19 @@ test-suite aeson-typescript-tests test src default-extensions: + LambdaCase + MultiWayIf + NamedFieldPuns OverloadedStrings + QuasiQuotes + RecordWildCards ScopedTypeVariables - KindSignatures + TupleSections + ViewPatterns FlexibleContexts - QuasiQuotes + KindSignatures TemplateHaskell TypeFamilies - LambdaCase ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N -haddock -fno-warn-unused-top-binds -fno-warn-orphans build-depends: aeson diff --git a/flake.lock b/flake.lock new file mode 100644 index 0000000..aeb0daf --- /dev/null +++ b/flake.lock @@ -0,0 +1,689 @@ +{ + "nodes": { + "HTTP": { + "flake": false, + "locked": { + "lastModified": 1451647621, + "narHash": "sha256-oHIyw3x0iKBexEo49YeUDV1k74ZtyYKGR2gNJXXRxts=", + "owner": "phadej", + "repo": "HTTP", + "rev": "9bc0996d412fef1787449d841277ef663ad9a915", + "type": "github" + }, + "original": { + "owner": "phadej", + "repo": "HTTP", + "type": "github" + } + }, + "cabal-32": { + "flake": false, + "locked": { + "lastModified": 1603716527, + "narHash": "sha256-X0TFfdD4KZpwl0Zr6x+PLxUt/VyKQfX7ylXHdmZIL+w=", + "owner": "haskell", + "repo": "cabal", + "rev": "48bf10787e27364730dd37a42b603cee8d6af7ee", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "3.2", + "repo": "cabal", + "type": "github" + } + }, + "cabal-34": { + "flake": false, + "locked": { + "lastModified": 1645834128, + "narHash": "sha256-wG3d+dOt14z8+ydz4SL7pwGfe7SiimxcD/LOuPCV6xM=", + "owner": "haskell", + "repo": "cabal", + "rev": "5ff598c67f53f7c4f48e31d722ba37172230c462", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "3.4", + "repo": "cabal", + "type": "github" + } + }, + "cabal-36": { + "flake": false, + "locked": { + "lastModified": 1669081697, + "narHash": "sha256-I5or+V7LZvMxfbYgZATU4awzkicBwwok4mVoje+sGmU=", + "owner": "haskell", + "repo": "cabal", + "rev": "8fd619e33d34924a94e691c5fea2c42f0fc7f144", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "3.6", + "repo": "cabal", + "type": "github" + } + }, + "cardano-shell": { + "flake": false, + "locked": { + "lastModified": 1608537748, + "narHash": "sha256-PulY1GfiMgKVnBci3ex4ptk2UNYMXqGjJOxcPy2KYT4=", + "owner": "input-output-hk", + "repo": "cardano-shell", + "rev": "9392c75087cb9a3d453998f4230930dea3a95725", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "cardano-shell", + "type": "github" + } + }, + "flake-compat": { + "flake": false, + "locked": { + "lastModified": 1672831974, + "narHash": "sha256-z9k3MfslLjWQfnjBtEtJZdq3H7kyi2kQtUThfTgdRk0=", + "owner": "input-output-hk", + "repo": "flake-compat", + "rev": "45f2638735f8cdc40fe302742b79f248d23eb368", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "ref": "hkm/gitlab-fix", + "repo": "flake-compat", + "type": "github" + } + }, + "flake-utils": { + "inputs": { + "systems": "systems" + }, + "locked": { + "lastModified": 1731533236, + "narHash": "sha256-l0KFg5HjrsfsO/JpG+r7fRrqm12kzFHyUHqHCVpMMbI=", + "owner": "numtide", + "repo": "flake-utils", + "rev": "11707dc2f618dd54ca8739b309ec4fc024de578b", + "type": "github" + }, + "original": { + "owner": "numtide", + "repo": "flake-utils", + "type": "github" + } + }, + "ghc-8.6.5-iohk": { + "flake": false, + "locked": { + "lastModified": 1600920045, + "narHash": "sha256-DO6kxJz248djebZLpSzTGD6s8WRpNI9BTwUeOf5RwY8=", + "owner": "input-output-hk", + "repo": "ghc", + "rev": "95713a6ecce4551240da7c96b6176f980af75cae", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "ref": "release/8.6.5-iohk", + "repo": "ghc", + "type": "github" + } + }, + "gitignore": { + "inputs": { + "nixpkgs": [ + "nixpkgs" + ] + }, + "locked": { + "lastModified": 1709087332, + "narHash": "sha256-HG2cCnktfHsKV0s4XW83gU3F57gaTljL9KNSuG6bnQs=", + "owner": "hercules-ci", + "repo": "gitignore.nix", + "rev": "637db329424fd7e46cf4185293b9cc8c88c95394", + "type": "github" + }, + "original": { + "owner": "hercules-ci", + "repo": "gitignore.nix", + "type": "github" + } + }, + "hackage": { + "flake": false, + "locked": { + "lastModified": 1753922646, + "narHash": "sha256-eVvEjP9s6iQCPQFbb66+Gzd3ZM6BjIqfFzuf/yk9D7U=", + "owner": "input-output-hk", + "repo": "hackage.nix", + "rev": "224f3770869031c2129c82061aeeabb6b8035aad", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "hackage.nix", + "type": "github" + } + }, + "hackage-for-stackage": { + "flake": false, + "locked": { + "lastModified": 1753921689, + "narHash": "sha256-F7yJ6l+Qb97hCTrBn24JeX4bzg5dEARtQ2HJKy3Vc48=", + "owner": "input-output-hk", + "repo": "hackage.nix", + "rev": "b8dbf163f00e329f2090733108b427c03d6976fc", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "ref": "for-stackage", + "repo": "hackage.nix", + "type": "github" + } + }, + "hackage-internal": { + "flake": false, + "locked": { + "lastModified": 1750307553, + "narHash": "sha256-iiafNoeLHwlSLQTyvy8nPe2t6g5AV4PPcpMeH/2/DLs=", + "owner": "input-output-hk", + "repo": "hackage.nix", + "rev": "f7867baa8817fab296528f4a4ec39d1c7c4da4f3", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "hackage.nix", + "type": "github" + } + }, + "haskellNix": { + "inputs": { + "HTTP": "HTTP", + "cabal-32": "cabal-32", + "cabal-34": "cabal-34", + "cabal-36": "cabal-36", + "cardano-shell": "cardano-shell", + "flake-compat": "flake-compat", + "ghc-8.6.5-iohk": "ghc-8.6.5-iohk", + "hackage": "hackage", + "hackage-for-stackage": "hackage-for-stackage", + "hackage-internal": "hackage-internal", + "hls": "hls", + "hls-1.10": "hls-1.10", + "hls-2.0": "hls-2.0", + "hls-2.10": "hls-2.10", + "hls-2.11": "hls-2.11", + "hls-2.2": "hls-2.2", + "hls-2.3": "hls-2.3", + "hls-2.4": "hls-2.4", + "hls-2.5": "hls-2.5", + "hls-2.6": "hls-2.6", + "hls-2.7": "hls-2.7", + "hls-2.8": "hls-2.8", + "hls-2.9": "hls-2.9", + "hpc-coveralls": "hpc-coveralls", + "iserv-proxy": "iserv-proxy", + "nixpkgs": [ + "haskellNix", + "nixpkgs-unstable" + ], + "nixpkgs-2305": "nixpkgs-2305", + "nixpkgs-2311": "nixpkgs-2311", + "nixpkgs-2405": "nixpkgs-2405", + "nixpkgs-2411": "nixpkgs-2411", + "nixpkgs-2505": "nixpkgs-2505", + "nixpkgs-unstable": "nixpkgs-unstable", + "old-ghc-nix": "old-ghc-nix", + "stackage": "stackage" + }, + "locked": { + "lastModified": 1753923139, + "narHash": "sha256-9LriT9Da9oQ5+PhUBZCHqmzRMv2M2lJ8ts6KgJX2DKQ=", + "owner": "input-output-hk", + "repo": "haskell.nix", + "rev": "758d34c249352818ee786abb06068b8a9e29c098", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "haskell.nix", + "type": "github" + } + }, + "hls": { + "flake": false, + "locked": { + "lastModified": 1741604408, + "narHash": "sha256-tuq3+Ip70yu89GswZ7DSINBpwRprnWnl6xDYnS4GOsc=", + "owner": "haskell", + "repo": "haskell-language-server", + "rev": "682d6894c94087da5e566771f25311c47e145359", + "type": "github" + }, + "original": { + "owner": "haskell", + "repo": "haskell-language-server", + "type": "github" + } + }, + "hls-1.10": { + "flake": false, + "locked": { + "lastModified": 1680000865, + "narHash": "sha256-rc7iiUAcrHxwRM/s0ErEsSPxOR3u8t7DvFeWlMycWgo=", + "owner": "haskell", + "repo": "haskell-language-server", + "rev": "b08691db779f7a35ff322b71e72a12f6e3376fd9", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "1.10.0.0", + "repo": "haskell-language-server", + "type": "github" + } + }, + "hls-2.0": { + "flake": false, + "locked": { + "lastModified": 1687698105, + "narHash": "sha256-OHXlgRzs/kuJH8q7Sxh507H+0Rb8b7VOiPAjcY9sM1k=", + "owner": "haskell", + "repo": "haskell-language-server", + "rev": "783905f211ac63edf982dd1889c671653327e441", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "2.0.0.1", + "repo": "haskell-language-server", + "type": "github" + } + }, + "hls-2.10": { + "flake": false, + "locked": { + "lastModified": 1743069404, + "narHash": "sha256-q4kDFyJDDeoGqfEtrZRx4iqMVEC2MOzCToWsFY+TOzY=", + "owner": "haskell", + "repo": "haskell-language-server", + "rev": "2318c61db3a01e03700bd4b05665662929b7fe8b", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "2.10.0.0", + "repo": "haskell-language-server", + "type": "github" + } + }, + "hls-2.11": { + "flake": false, + "locked": { + "lastModified": 1747306193, + "narHash": "sha256-/MmtpF8+FyQlwfKHqHK05BdsxC9LHV70d/FiMM7pzBM=", + "owner": "haskell", + "repo": "haskell-language-server", + "rev": "46ef4523ea4949f47f6d2752476239f1c6d806fe", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "2.11.0.0", + "repo": "haskell-language-server", + "type": "github" + } + }, + "hls-2.2": { + "flake": false, + "locked": { + "lastModified": 1693064058, + "narHash": "sha256-8DGIyz5GjuCFmohY6Fa79hHA/p1iIqubfJUTGQElbNk=", + "owner": "haskell", + "repo": "haskell-language-server", + "rev": "b30f4b6cf5822f3112c35d14a0cba51f3fe23b85", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "2.2.0.0", + "repo": "haskell-language-server", + "type": "github" + } + }, + "hls-2.3": { + "flake": false, + "locked": { + "lastModified": 1695910642, + "narHash": "sha256-tR58doOs3DncFehHwCLczJgntyG/zlsSd7DgDgMPOkI=", + "owner": "haskell", + "repo": "haskell-language-server", + "rev": "458ccdb55c9ea22cd5d13ec3051aaefb295321be", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "2.3.0.0", + "repo": "haskell-language-server", + "type": "github" + } + }, + "hls-2.4": { + "flake": false, + "locked": { + "lastModified": 1699862708, + "narHash": "sha256-YHXSkdz53zd0fYGIYOgLt6HrA0eaRJi9mXVqDgmvrjk=", + "owner": "haskell", + "repo": "haskell-language-server", + "rev": "54507ef7e85fa8e9d0eb9a669832a3287ffccd57", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "2.4.0.1", + "repo": "haskell-language-server", + "type": "github" + } + }, + "hls-2.5": { + "flake": false, + "locked": { + "lastModified": 1701080174, + "narHash": "sha256-fyiR9TaHGJIIR0UmcCb73Xv9TJq3ht2ioxQ2mT7kVdc=", + "owner": "haskell", + "repo": "haskell-language-server", + "rev": "27f8c3d3892e38edaef5bea3870161815c4d014c", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "2.5.0.0", + "repo": "haskell-language-server", + "type": "github" + } + }, + "hls-2.6": { + "flake": false, + "locked": { + "lastModified": 1705325287, + "narHash": "sha256-+P87oLdlPyMw8Mgoul7HMWdEvWP/fNlo8jyNtwME8E8=", + "owner": "haskell", + "repo": "haskell-language-server", + "rev": "6e0b342fa0327e628610f2711f8c3e4eaaa08b1e", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "2.6.0.0", + "repo": "haskell-language-server", + "type": "github" + } + }, + "hls-2.7": { + "flake": false, + "locked": { + "lastModified": 1708965829, + "narHash": "sha256-LfJ+TBcBFq/XKoiNI7pc4VoHg4WmuzsFxYJ3Fu+Jf+M=", + "owner": "haskell", + "repo": "haskell-language-server", + "rev": "50322b0a4aefb27adc5ec42f5055aaa8f8e38001", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "2.7.0.0", + "repo": "haskell-language-server", + "type": "github" + } + }, + "hls-2.8": { + "flake": false, + "locked": { + "lastModified": 1715153580, + "narHash": "sha256-Vi/iUt2pWyUJlo9VrYgTcbRviWE0cFO6rmGi9rmALw0=", + "owner": "haskell", + "repo": "haskell-language-server", + "rev": "dd1be1beb16700de59e0d6801957290bcf956a0a", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "2.8.0.0", + "repo": "haskell-language-server", + "type": "github" + } + }, + "hls-2.9": { + "flake": false, + "locked": { + "lastModified": 1719993701, + "narHash": "sha256-wy348++MiMm/xwtI9M3vVpqj2qfGgnDcZIGXw8sF1sA=", + "owner": "haskell", + "repo": "haskell-language-server", + "rev": "90319a7e62ab93ab65a95f8f2bcf537e34dae76a", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "2.9.0.1", + "repo": "haskell-language-server", + "type": "github" + } + }, + "hpc-coveralls": { + "flake": false, + "locked": { + "lastModified": 1607498076, + "narHash": "sha256-8uqsEtivphgZWYeUo5RDUhp6bO9j2vaaProQxHBltQk=", + "owner": "sevanspowell", + "repo": "hpc-coveralls", + "rev": "14df0f7d229f4cd2e79f8eabb1a740097fdfa430", + "type": "github" + }, + "original": { + "owner": "sevanspowell", + "repo": "hpc-coveralls", + "type": "github" + } + }, + "iserv-proxy": { + "flake": false, + "locked": { + "lastModified": 1750543273, + "narHash": "sha256-WaswH0Y+Fmupvv8AkIlQBlUy/IdD3Inx9PDuE+5iRYY=", + "owner": "stable-haskell", + "repo": "iserv-proxy", + "rev": "a53c57c9a8d22a66a2f0c4c969e806da03f08c28", + "type": "github" + }, + "original": { + "owner": "stable-haskell", + "ref": "iserv-syms", + "repo": "iserv-proxy", + "type": "github" + } + }, + "nixpkgs-2305": { + "locked": { + "lastModified": 1705033721, + "narHash": "sha256-K5eJHmL1/kev6WuqyqqbS1cdNnSidIZ3jeqJ7GbrYnQ=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "a1982c92d8980a0114372973cbdfe0a307f1bdea", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixpkgs-23.05-darwin", + "repo": "nixpkgs", + "type": "github" + } + }, + "nixpkgs-2311": { + "locked": { + "lastModified": 1719957072, + "narHash": "sha256-gvFhEf5nszouwLAkT9nWsDzocUTqLWHuL++dvNjMp9I=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "7144d6241f02d171d25fba3edeaf15e0f2592105", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixpkgs-23.11-darwin", + "repo": "nixpkgs", + "type": "github" + } + }, + "nixpkgs-2405": { + "locked": { + "lastModified": 1735564410, + "narHash": "sha256-HB/FA0+1gpSs8+/boEavrGJH+Eq08/R2wWNph1sM1Dg=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "1e7a8f391f1a490460760065fa0630b5520f9cf8", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixpkgs-24.05-darwin", + "repo": "nixpkgs", + "type": "github" + } + }, + "nixpkgs-2411": { + "locked": { + "lastModified": 1748037224, + "narHash": "sha256-92vihpZr6dwEMV6g98M5kHZIttrWahb9iRPBm1atcPk=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "f09dede81861f3a83f7f06641ead34f02f37597f", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixpkgs-24.11-darwin", + "repo": "nixpkgs", + "type": "github" + } + }, + "nixpkgs-2505": { + "locked": { + "lastModified": 1748852332, + "narHash": "sha256-r/wVJWmLYEqvrJKnL48r90Wn9HWX9SHFt6s4LhuTh7k=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "a8167f3cc2f991dd4d0055746df53dae5fd0c953", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixpkgs-25.05-darwin", + "repo": "nixpkgs", + "type": "github" + } + }, + "nixpkgs-unstable": { + "locked": { + "lastModified": 1748856973, + "narHash": "sha256-RlTsJUvvr8ErjPBsiwrGbbHYW8XbB/oek0Gi78XdWKg=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "e4b09e47ace7d87de083786b404bf232eb6c89d8", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixpkgs-unstable", + "repo": "nixpkgs", + "type": "github" + } + }, + "nixpkgsMaster": { + "locked": { + "lastModified": 1753975144, + "narHash": "sha256-QsCqY2NnLN+47+j/J8V0PHemua+iA7em8pw1yID1RN0=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "63e24fbc205fc7484ac7c90212a94853be116de4", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "master", + "repo": "nixpkgs", + "type": "github" + } + }, + "old-ghc-nix": { + "flake": false, + "locked": { + "lastModified": 1631092763, + "narHash": "sha256-sIKgO+z7tj4lw3u6oBZxqIhDrzSkvpHtv0Kki+lh9Fg=", + "owner": "angerman", + "repo": "old-ghc-nix", + "rev": "af48a7a7353e418119b6dfe3cd1463a657f342b8", + "type": "github" + }, + "original": { + "owner": "angerman", + "ref": "master", + "repo": "old-ghc-nix", + "type": "github" + } + }, + "root": { + "inputs": { + "flake-utils": "flake-utils", + "gitignore": "gitignore", + "haskellNix": "haskellNix", + "nixpkgs": [ + "haskellNix", + "nixpkgs" + ], + "nixpkgsMaster": "nixpkgsMaster" + } + }, + "stackage": { + "flake": false, + "locked": { + "lastModified": 1753920846, + "narHash": "sha256-jk2dKSlLgEfwpwocH2GX9mfwLSV0anmyjJ400zqCGq8=", + "owner": "input-output-hk", + "repo": "stackage.nix", + "rev": "edb12eda18a509b65576505316a7419ad2dbfb69", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "stackage.nix", + "type": "github" + } + }, + "systems": { + "locked": { + "lastModified": 1681028828, + "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=", + "owner": "nix-systems", + "repo": "default", + "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e", + "type": "github" + }, + "original": { + "owner": "nix-systems", + "repo": "default", + "type": "github" + } + } + }, + "root": "root", + "version": 7 +} diff --git a/flake.nix b/flake.nix new file mode 100644 index 0000000..bebda18 --- /dev/null +++ b/flake.nix @@ -0,0 +1,76 @@ +{ + description = "aeson-typescript"; + + inputs.flake-utils.url = "github:numtide/flake-utils"; + inputs.gitignore = { + url = "github:hercules-ci/gitignore.nix"; + inputs.nixpkgs.follows = "nixpkgs"; + }; + inputs.haskellNix.url = "github:input-output-hk/haskell.nix"; + inputs.nixpkgs.follows = "haskellNix/nixpkgs"; + inputs.nixpkgsMaster.url = "github:NixOS/nixpkgs/master"; + + outputs = { self, flake-utils, gitignore, haskellNix, nixpkgs, nixpkgsMaster }: + flake-utils.lib.eachDefaultSystem (system: + let + # compiler-nix-name = "ghc966"; + compiler-nix-name = "ghc984"; + # compiler-nix-name = "ghc9101"; + + pkgs = import nixpkgs { + inherit system; + overlays = [haskellNix.overlay]; + inherit (haskellNix) config; + }; + + pkgsMaster = import nixpkgsMaster { + inherit system; + }; + + src = gitignore.lib.gitignoreSource ./.; + + flake = (pkgs.haskell-nix.hix.project { + inherit src compiler-nix-name; + evalSystem = system; + projectFileName = "stack.yaml"; + modules = []; + }).flake {}; + + flakeWindows = (pkgs.pkgsCross.mingwW64.haskell-nix.hix.project { + inherit src compiler-nix-name; + evalSystem = system; + # projectFileName = "stack.yaml"; + projectFileName = "stack-9.8.4.yaml"; + # projectFileName = "stack-9.10.1.yaml"; + modules = [{ + reinstallableLibGhc = false; + }]; + }).flake {}; + + in + { + packages = { + inherit (pkgs.haskell.packages.${compiler-nix-name}) weeder; + + inherit flake; + + normal = flake.packages."aeson-typescript:lib:aeson-typescript"; + windows = flakeWindows.packages."aeson-typescript:lib:aeson-typescript"; + + test = pkgs.writeShellScriptBin "stack-test" '' + export NIX_PATH=nixpkgs=${pkgs.path} + ${pkgs.stack}/bin/stack test + ''; + + nixpkgsPath = pkgs.writeShellScriptBin "nixpkgsPath.sh" "echo -n ${pkgs.path}"; + }; + + devShells.default = pkgs.mkShell { + buildInputs = with pkgs; [ + pkgs.nodePackages.typescript + pkgsMaster.haskell.compiler.ghc9122 + (pkgsMaster.haskell-language-server.override { supportedGhcVersions = ["9122"]; }) + ]; + }; + }); +} diff --git a/package.yaml b/package.yaml index 4626235..0f0fde4 100644 --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: aeson-typescript -version: 0.4.2.0 +version: 0.6.4.0 github: "codedownio/aeson-typescript" license: BSD3 category: Text, Web, JSON @@ -23,11 +23,19 @@ synopsis: Generate TypeScript definition files from your ADTs # common to point users to the README.md file. description: Please see the README on Github at -tested-with: GHC == 9.0.1, GHC == 8.10.4, GHC == 8.10.3, GHC == 8.8.4, GHC == 8.8.3 +tested-with: +- GHC == 9.6.1 +- GHC == 9.4.4 +- GHC == 9.2.7 +- GHC == 9.0.2 +- GHC == 8.10.7 +- GHC == 8.8.4 +- GHC == 8.6.5 dependencies: - aeson - base >= 4.7 && < 5 +- bytestring - containers - mtl - string-interpolate @@ -37,13 +45,24 @@ dependencies: - transformers - unordered-containers +default-extensions: +- LambdaCase +- MultiWayIf +- NamedFieldPuns +- OverloadedStrings +- QuasiQuotes +- RecordWildCards +- ScopedTypeVariables +- TupleSections +- ViewPatterns + library: source-dirs: src exposed-modules: - - Data.Aeson.TypeScript.TH - - Data.Aeson.TypeScript.Internal - - Data.Aeson.TypeScript.Recursive - - Data.Aeson.TypeScript.LegalName + - Data.Aeson.TypeScript.TH + - Data.Aeson.TypeScript.Internal + - Data.Aeson.TypeScript.Recursive + - Data.Aeson.TypeScript.LegalName tests: aeson-typescript-tests: @@ -60,14 +79,10 @@ tests: - -fno-warn-unused-top-binds - -fno-warn-orphans default-extensions: - - OverloadedStrings - - ScopedTypeVariables - - KindSignatures - FlexibleContexts - - QuasiQuotes + - KindSignatures - TemplateHaskell - TypeFamilies - - LambdaCase dependencies: - aeson-typescript - bytestring diff --git a/src/Data/Aeson/TypeScript/Formatting.hs b/src/Data/Aeson/TypeScript/Formatting.hs index eec3e7d..9412b53 100644 --- a/src/Data/Aeson/TypeScript/Formatting.hs +++ b/src/Data/Aeson/TypeScript/Formatting.hs @@ -1,9 +1,13 @@ -{-# LANGUAGE QuasiQuotes, OverloadedStrings, TemplateHaskell, RecordWildCards, ScopedTypeVariables, NamedFieldPuns, CPP #-} +{-# LANGUAGE CPP #-} module Data.Aeson.TypeScript.Formatting where +import Data.Aeson as A import Data.Aeson.TypeScript.Types +import qualified Data.ByteString.Lazy.Char8 as BL8 +import Data.Function ((&)) import qualified Data.List as L +import Data.Maybe import Data.String.Interpolate import qualified Data.Text as T @@ -18,25 +22,46 @@ 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 {..}) (TSTypeAlternatives name genericVariables names) = - case typeAlternativesFormat of - Enum -> [i|#{exportPrefix exportMode}enum #{typeNameModifier name} { #{alternativesEnum} }|] - EnumWithType -> [i|#{exportPrefix exportMode}enum #{typeNameModifier name} { #{alternativesEnumWithType} }#{enumType}|] - TypeAlias -> [i|#{exportPrefix exportMode}type #{typeNameModifier name}#{getGenericBrackets genericVariables} = #{alternatives};|] +formatTSDeclaration (FormattingOptions {..}) (TSTypeAlternatives name genericVariables names maybeDoc) = + makeDocPrefix maybeDoc <> mainDeclaration where - alternatives = T.intercalate " | " (fmap T.pack names) - alternativesEnum = T.intercalate ", " $ [toEnumName entry | entry <- T.pack <$> names] - alternativesEnumWithType = T.intercalate ", " $ [toEnumName entry <> "=" <> entry | entry <- T.pack <$> names] - enumType = [i|\n\ntype #{name} = keyof typeof #{typeNameModifier name};|] :: T.Text + mainDeclaration = case chooseTypeAlternativesFormat typeAlternativesFormat of + Enum -> [i|#{exportPrefix exportMode}enum #{typeNameModifier name} { #{alternativesEnum} }|] + where + alternativesEnum = T.intercalate ", " $ [toEnumName entry <> "=" <> entry | entry <- T.pack <$> names] + EnumWithType -> [i|#{exportPrefix exportMode}enum #{typeNameModifier name}Enum { #{alternativesEnumWithType} }#{enumType}|] + where + alternativesEnumWithType = T.intercalate ", " $ [toEnumName entry <> "=" <> entry | entry <- T.pack <$> names] + enumType = [i|\n\ntype #{name} = keyof typeof #{typeNameModifier name}Enum;|] :: T.Text + TypeAlias -> [i|#{exportPrefix exportMode}type #{typeNameModifier name}#{getGenericBrackets genericVariables} = #{alternatives};|] + where + alternatives = T.intercalate " | " (fmap T.pack names) + + -- Only allow certain formats if some checks pass + chooseTypeAlternativesFormat Enum + | all isDoubleQuotedString names = Enum + | otherwise = TypeAlias + chooseTypeAlternativesFormat EnumWithType + | all isDoubleQuotedString names = EnumWithType + | otherwise = TypeAlias + chooseTypeAlternativesFormat x = x + + isDoubleQuotedString s = case A.eitherDecode (BL8.pack s) of + Right (A.String _) -> True + _ -> False + toEnumName = T.replace "\"" "" -formatTSDeclaration (FormattingOptions {..}) (TSInterfaceDeclaration interfaceName genericVariables members) = - [i|#{exportPrefix exportMode}interface #{modifiedInterfaceName}#{getGenericBrackets genericVariables} { +formatTSDeclaration (FormattingOptions {..}) (TSInterfaceDeclaration interfaceName genericVariables (filter (not . isNoEmitTypeScriptField) -> members) maybeDoc) = + makeDocPrefix maybeDoc <> [i|#{exportPrefix exportMode}interface #{modifiedInterfaceName}#{getGenericBrackets genericVariables} { #{ls} }|] where ls = T.intercalate "\n" $ [indentTo numIndentSpaces (T.pack (formatTSField member <> ";")) | member <- members] modifiedInterfaceName = (\(li, name) -> li <> interfaceNameModifier name) . splitAt 1 $ interfaceName + formatTSField :: TSField -> String + formatTSField (TSField optional name typ maybeDoc') = makeDocPrefix maybeDoc' <> [i|#{name}#{if optional then ("?" :: String) else ""}: #{typ}|] + formatTSDeclaration _ (TSRawDeclaration text) = text indentTo :: Int -> T.Text -> T.Text @@ -49,32 +74,48 @@ exportPrefix ExportNone = "" -- | 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 (validateFormattingOptions options declarations)) declarations) - -validateFormattingOptions :: FormattingOptions -> [TSDeclaration] -> FormattingOptions -validateFormattingOptions options@FormattingOptions{..} decls - | typeAlternativesFormat == Enum && isPlainSumType decls = options - | typeAlternativesFormat == EnumWithType && isPlainSumType decls = options { typeNameModifier = flip (<>) "Enum" } - | otherwise = options { typeAlternativesFormat = TypeAlias } - where - isInterface :: TSDeclaration -> Bool - isInterface TSInterfaceDeclaration{} = True - isInterface _ = False - - -- Plain sum types have only one declaration with multiple alternatives - -- Units (data U = U) contain two declarations, and thus are invalid - isPlainSumType ds = (not . any isInterface $ ds) && length ds == 1 - -formatTSField :: TSField -> String -formatTSField (TSField optional name typ maybeDoc) = docPrefix <> [i|#{name}#{if optional then ("?" :: String) else ""}: #{typ}|] +formatTSDeclarations' options allDeclarations = + declarations & fmap (T.pack . formatTSDeclaration options) + & T.intercalate "\n\n" + & T.unpack where - docPrefix = case maybeDoc of - Nothing -> "" - Just doc | '\n' `L.elem` doc -> "/* " <> (deleteLeadingWhitespace doc) <> " */\n" - Just doc -> "// " <> (deleteLeadingWhitespace doc) <> "\n" - - deleteLeadingWhitespace = L.dropWhile (== ' ') + removedDeclarationNames = mapMaybe getDeclarationName (filter isNoEmitTypeScriptDeclaration allDeclarations) + where + getDeclarationName :: TSDeclaration -> Maybe String + getDeclarationName (TSInterfaceDeclaration {..}) = Just interfaceName + getDeclarationName (TSTypeAlternatives {..}) = Just typeName + getDeclarationName _ = Nothing + + removeReferencesToRemovedNames :: [String] -> TSDeclaration -> TSDeclaration + removeReferencesToRemovedNames removedNames decl@(TSTypeAlternatives {..}) = decl { alternativeTypes = [x | x <- alternativeTypes, not (x `L.elem` removedNames)] } + removeReferencesToRemovedNames _ x = x + + declarations = allDeclarations + & filter (not . isNoEmitTypeScriptDeclaration) + & fmap (removeReferencesToRemovedNames removedDeclarationNames) + +makeDocPrefix :: Maybe String -> String +makeDocPrefix maybeDoc = case maybeDoc of + Nothing -> "" + Just (T.pack -> text) -> ["// " <> line | line <- T.splitOn "\n" text] + & T.intercalate "\n" + & (<> "\n") + & T.unpack getGenericBrackets :: [String] -> String getGenericBrackets [] = "" getGenericBrackets xs = [i|<#{T.intercalate ", " (fmap T.pack xs)}>|] + +-- * Support for @no-emit-typescript + +noEmitTypeScriptAnnotation :: String +noEmitTypeScriptAnnotation = "@no-emit-typescript" + +isNoEmitTypeScriptField :: TSField -> Bool +isNoEmitTypeScriptField (TSField {fieldDoc=(Just doc)}) = noEmitTypeScriptAnnotation `L.isInfixOf` doc +isNoEmitTypeScriptField _ = False + +isNoEmitTypeScriptDeclaration :: TSDeclaration -> Bool +isNoEmitTypeScriptDeclaration (TSInterfaceDeclaration {interfaceDoc=(Just doc)}) = noEmitTypeScriptAnnotation `L.isInfixOf` doc +isNoEmitTypeScriptDeclaration (TSTypeAlternatives {typeDoc=(Just doc)}) = noEmitTypeScriptAnnotation `L.isInfixOf` doc +isNoEmitTypeScriptDeclaration _ = False diff --git a/src/Data/Aeson/TypeScript/Instances.hs b/src/Data/Aeson/TypeScript/Instances.hs index ee566be..2f61ce6 100644 --- a/src/Data/Aeson/TypeScript/Instances.hs +++ b/src/Data/Aeson/TypeScript/Instances.hs @@ -1,12 +1,10 @@ -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverlappingInstances #-} {-# LANGUAGE CPP #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- Note: the OverlappingInstances pragma is only here so the overlapping instances in this file @@ -15,11 +13,18 @@ module Data.Aeson.TypeScript.Instances where import qualified Data.Aeson as A +import Data.Aeson.TypeScript.Instances.TupleGen import Data.Aeson.TypeScript.Types import Data.Data +import Data.Functor.Compose (Compose) +import Data.Functor.Const (Const) +import Data.Functor.Identity (Identity) +import Data.Functor.Product (Product) import Data.HashMap.Strict import Data.HashSet +import Data.Kind (Type) import qualified Data.List as L +import Data.List.NonEmpty (NonEmpty) import Data.Map.Strict import Data.Set import Data.String.Interpolate @@ -28,6 +33,7 @@ import qualified Data.Text.Lazy as TL import Data.Void import Data.Word import GHC.Int +import Numeric.Natural (Natural) #if !MIN_VERSION_base(4,11,0) import Data.Monoid @@ -53,6 +59,9 @@ instance TypeScript TL.Text where instance TypeScript Integer where getTypeScriptType _ = "number" +instance TypeScript Natural where + getTypeScriptType _ = "number" + instance TypeScript Float where getTypeScriptType _ = "number" @@ -77,45 +86,65 @@ instance TypeScript Int64 where instance TypeScript Char where getTypeScriptType _ = "string" +instance TypeScript Word where + getTypeScriptType _ = "number" + instance TypeScript Word8 where getTypeScriptType _ = "number" +instance TypeScript Word16 where + getTypeScriptType _ = "number" + +instance TypeScript Word32 where + getTypeScriptType _ = "number" + +instance TypeScript Word64 where + getTypeScriptType _ = "number" + instance {-# OVERLAPPABLE #-} (TypeScript a) => TypeScript [a] where getTypeScriptType _ = (getTypeScriptType (Proxy :: Proxy a)) ++ "[]" getParentTypes _ = [TSType (Proxy :: Proxy a)] +instance (TypeScript a) => TypeScript (NonEmpty a) where + getTypeScriptType _ = getTypeScriptType (Proxy :: Proxy [a]) + getParentTypes _ = [TSType (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", "Right"] - , TSInterfaceDeclaration "Left" ["T"] [TSField False "Left" "T" Nothing] - , TSInterfaceDeclaration "Right" ["T"] [TSField False "Right" "T" Nothing] + getTypeScriptDeclarations _ = [TSTypeAlternatives "Either" ["T1", "T2"] ["Left", "Right"] Nothing + , TSInterfaceDeclaration "Left" ["T"] [TSField False "Left" "T" Nothing] Nothing + , TSInterfaceDeclaration "Right" ["T"] [TSField False "Right" "T" Nothing] Nothing ] getParentTypes _ = L.nub [ (TSType (Proxy :: Proxy a)) , (TSType (Proxy :: Proxy b)) ] -instance (TypeScript a, TypeScript b) => TypeScript (a, b) where - getTypeScriptType _ = [i|[#{getTypeScriptType (Proxy :: Proxy a)}, #{getTypeScriptType (Proxy :: Proxy b)}]|] - getParentTypes _ = L.nub [ (TSType (Proxy :: Proxy a)) - , (TSType (Proxy :: Proxy b)) - ] +-- Derive instance TypeScript (a, b), instance TypeScript (a, b, c), etc. up to size 10 +mkTupleInstances 10 -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)}]|] - getParentTypes _ = L.nub [ (TSType (Proxy :: Proxy a)) - , (TSType (Proxy :: Proxy b)) - , (TSType (Proxy :: Proxy c)) - ] +instance forall a k (b :: k). (Typeable k, Typeable b, TypeScript a) => TypeScript (Const a b) where + getTypeScriptType _ = getTypeScriptType (Proxy :: Proxy a) + getParentTypes _ = [TSType (Proxy :: Proxy a)] -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)}]|] - getParentTypes _ = L.nub [ (TSType (Proxy :: Proxy a)) - , (TSType (Proxy :: Proxy b)) - , (TSType (Proxy :: Proxy c)) - , (TSType (Proxy :: Proxy d)) +instance (TypeScript a) => TypeScript (Identity a) where + getTypeScriptType _ = getTypeScriptType (Proxy :: Proxy a) + getParentTypes _ = [TSType (Proxy :: Proxy a)] + +instance forall k k1 (f :: k -> Type) (g :: k1 -> k) a. ( + Typeable k, Typeable k1, Typeable f, Typeable g, Typeable a, TypeScript (f (g a)), TypeScript a + ) => TypeScript (Compose f g a) where + getTypeScriptType _ = getTypeScriptType (Proxy :: Proxy (f (g a))) + getParentTypes _ = getParentTypes (Proxy :: Proxy (f (g a))) + +instance forall k (f :: k -> Type) (g :: k -> Type) a. ( + Typeable k, Typeable f, Typeable g, Typeable a, TypeScript (f a), TypeScript (g a) + ) => TypeScript (Product f g a) where + getTypeScriptType _ = getTypeScriptType (Proxy :: Proxy (f a, g a)) + getParentTypes _ = L.nub [ (TSType (Proxy :: Proxy (f a))) + , (TSType (Proxy :: Proxy (g a))) ] instance (TypeScript a) => TypeScript (Maybe a) where @@ -126,13 +155,18 @@ instance (TypeScript a) => TypeScript (Maybe a) where instance TypeScript A.Value where getTypeScriptType _ = "any"; -instance (TypeScript a, TypeScript b) => TypeScript (Map a b) where - getTypeScriptType _ = "{[k in " ++ getTypeScriptKeyType (Proxy :: Proxy a) ++ "]?: " ++ getTypeScriptType (Proxy :: Proxy b) ++ "}" - getParentTypes _ = [TSType (Proxy :: Proxy a), TSType (Proxy :: Proxy b)] - -instance (TypeScript a, TypeScript b) => TypeScript (HashMap a b) where - getTypeScriptType _ = [i|{[k in #{getTypeScriptKeyType (Proxy :: Proxy a)}]?: #{getTypeScriptType (Proxy :: Proxy b)}}|] - getParentTypes _ = L.nub [TSType (Proxy :: Proxy a), TSType (Proxy :: Proxy b)] +instance (TypeScript a, TypeScript b, A.ToJSONKey a) => TypeScript (Map a b) where + getTypeScriptType = + let k = getTypeScriptKeyType @a Proxy + v = getTypeScriptType @b Proxy + in const $ case A.toJSONKey @a of + A.ToJSONKeyText {} -> "{[k in " <> k <> "]: " <> v <> "}" + A.ToJSONKeyValue {} -> getTypeScriptType @[(a, b)] Proxy + getParentTypes = const $ L.nub [TSType @a Proxy, TSType @b Proxy] + +instance (TypeScript a, TypeScript b, A.ToJSONKey a) => TypeScript (HashMap a b) where + getTypeScriptType = const $ getTypeScriptType @(Map a b) Proxy + getParentTypes = const $ getParentTypes @(Map a b) Proxy #if MIN_VERSION_aeson(2,0,0) instance (TypeScript a) => TypeScript (A.KeyMap a) where diff --git a/src/Data/Aeson/TypeScript/Instances/TupleGen.hs b/src/Data/Aeson/TypeScript/Instances/TupleGen.hs new file mode 100644 index 0000000..e4ca456 --- /dev/null +++ b/src/Data/Aeson/TypeScript/Instances/TupleGen.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE QuasiQuotes #-} + +module Data.Aeson.TypeScript.Instances.TupleGen where + +import Data.Aeson.TypeScript.Types +import Data.Data +import Data.List (intercalate) +import qualified Data.List as L +import Language.Haskell.TH + + +mkTupleInstance :: Int -> Q Dec +mkTupleInstance n = do + let typeVars = take n $ map (mkName . (:[])) ['a'..] + constraints = map (\tv -> AppT (ConT ''TypeScript) (VarT tv)) typeVars + tupleType = foldl AppT (TupleT n) (map VarT typeVars) + instanceHead = AppT (ConT ''TypeScript) tupleType + + getTypeBody <- buildTypeBody typeVars + let getTypeMethod = FunD 'getTypeScriptType [Clause [WildP] (NormalB getTypeBody) []] + + let tsTypes = map (\tv -> AppE (ConE 'TSType) (SigE (ConE 'Proxy) (AppT (ConT ''Proxy) (VarT tv)))) typeVars + getParentsMethod = FunD 'getParentTypes [Clause [WildP] (NormalB (AppE (VarE 'L.nub) (ListE tsTypes))) []] + + return $ InstanceD Nothing constraints instanceHead [getTypeMethod, getParentsMethod] + +buildTypeBody :: [Name] -> Q Exp +buildTypeBody typeVars = do + let calls = map (\tv -> AppE (VarE 'getTypeScriptTypeOrOptionalNull) + (SigE (ConE 'Proxy) (AppT (ConT ''Proxy) (VarT tv)))) typeVars + parts = [LitE (StringL "[")] ++ intercalate [LitE (StringL ", ")] (map (:[]) calls) ++ [LitE (StringL "]")] + return $ foldr1 (\a b -> InfixE (Just a) (VarE '(++)) (Just b)) parts + +mkTupleInstances :: Int -> Q [Dec] +mkTupleInstances maxArity = mapM mkTupleInstance [2..maxArity] diff --git a/src/Data/Aeson/TypeScript/Lookup.hs b/src/Data/Aeson/TypeScript/Lookup.hs index 8c245c8..f51b2fd 100644 --- a/src/Data/Aeson/TypeScript/Lookup.hs +++ b/src/Data/Aeson/TypeScript/Lookup.hs @@ -1,17 +1,8 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE MultiWayIf #-} -{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE PolyKinds #-} -{-# LANGUAGE LambdaCase #-} module Data.Aeson.TypeScript.Lookup where @@ -39,7 +30,7 @@ deriveTypeScriptLookupType name declNameStr = do interfaceDecl <- getClosedTypeFamilyInterfaceDecl name eqns return [FunD (mkName declNameStr) [Clause [] (NormalB (ListE [interfaceDecl])) []]] - _ -> fail [i|Expected a close type family; got #{info}|] + _ -> fail [i|Expected a closed type family; got #{info}|] getClosedTypeFamilyInterfaceDecl :: Name -> [TySynEqn] -> Q Exp getClosedTypeFamilyInterfaceDecl name eqns = do @@ -53,9 +44,9 @@ getClosedTypeFamilyInterfaceDecl name eqns = do TySynEqn [ConT arg] result -> do [| TSField False (getTypeScriptType (Proxy :: Proxy $(conT arg))) (getTypeScriptType (Proxy :: Proxy $(return result))) Nothing |] #endif - x -> fail [i|aeson-typescript doesn't know yet how to handle this type family equation: '#{x}'|] + x -> fail [i|aeson-typescript doesn't know yet how to handle this type family equation when generating interface declaration: '#{x}'|] - [| TSInterfaceDeclaration $(TH.stringE $ nameBase name) [] (L.sortBy (compare `on` fieldName) $(listE $ fmap return fields)) |] + [| TSInterfaceDeclaration $(TH.stringE $ nameBase name) [] (L.sortBy (compare `on` fieldName) $(listE $ fmap return fields)) Nothing |] getClosedTypeFamilyImage :: [TySynEqn] -> Q [Type] getClosedTypeFamilyImage eqns = do @@ -65,4 +56,4 @@ getClosedTypeFamilyImage eqns = do #else TySynEqn [ConT _] result -> return result #endif - x -> fail [i|aeson-typescript doesn't know yet how to handle this type family equation: '#{x}'|] + x -> fail [i|aeson-typescript doesn't know yet how to handle this type family equation when calculating closed type family image: '#{x}'|] diff --git a/src/Data/Aeson/TypeScript/Recursive.hs b/src/Data/Aeson/TypeScript/Recursive.hs index e525bf6..e5f5daa 100755 --- a/src/Data/Aeson/TypeScript/Recursive.hs +++ b/src/Data/Aeson/TypeScript/Recursive.hs @@ -1,14 +1,6 @@ -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE MultiWayIf #-} -{-# LANGUAGE ViewPatterns #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE PolyKinds #-} module Data.Aeson.TypeScript.Recursive ( @@ -24,6 +16,7 @@ module Data.Aeson.TypeScript.Recursive ( , getAllParentTypes ) where +import Control.Monad import Control.Monad.State import Control.Monad.Trans.Maybe import Control.Monad.Writer @@ -39,7 +32,6 @@ import qualified Data.Set as S import Data.String.Interpolate import Language.Haskell.TH as TH import Language.Haskell.TH.Datatype -import Language.Haskell.TH.Syntax hiding (lift) getTransitiveClosure :: S.Set TSType -> S.Set TSType diff --git a/src/Data/Aeson/TypeScript/TH.hs b/src/Data/Aeson/TypeScript/TH.hs index 73c764e..6f926cf 100644 --- a/src/Data/Aeson/TypeScript/TH.hs +++ b/src/Data/Aeson/TypeScript/TH.hs @@ -1,17 +1,8 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE MultiWayIf #-} -{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE PolyKinds #-} -{-# LANGUAGE LambdaCase #-} {-| Module: Data.Aeson.TypeScript.TH @@ -146,6 +137,13 @@ module Data.Aeson.TypeScript.TH ( , T1(..) , T2(..) , T3(..) + , T4(..) + , T5(..) + , T6(..) + , T7(..) + , T8(..) + , T9(..) + , T10(..) , module Data.Aeson.TypeScript.Instances ) where @@ -217,10 +215,11 @@ deriveTypeScript' options name extraOptions = do let typeVariablePreds :: [Pred] = [AppT (ConT ''TypeScript) x | x <- getDataTypeVars dti] -- Build the declarations - (types, (extraDeclsOrGenericInfosInitial <>) -> extraDeclsOrGenericInfos) <- runWriterT $ mapM (handleConstructor options dti genericVariablesAndSuffixes) (datatypeCons dti) + (types, (extraDeclsOrGenericInfosInitial <>) -> extraDeclsOrGenericInfos) <- runWriterT $ mapM (handleConstructor extraOptions options dti genericVariablesAndSuffixes) (datatypeCons dti) typeDeclaration <- [|TSTypeAlternatives $(TH.stringE $ getTypeName (datatypeName dti)) $(genericVariablesListExpr True genericVariablesAndSuffixes) - $(listE $ fmap return types)|] + $(listE $ fmap return types) + $(tryGetDoc (haddockModifier extraOptions) (datatypeName dti))|] declarationsFunctionBody <- [| $(return typeDeclaration) : $(listE (fmap return [x | ExtraDecl x <- extraDeclsOrGenericInfos])) |] @@ -244,8 +243,8 @@ deriveTypeScript' options name extraOptions = do return (mconcat [x | ExtraTopLevelDecs x <- extraDeclsOrGenericInfos] <> inst) -- | Return a string to go in the top-level type declaration, plus an optional expression containing a declaration -handleConstructor :: Options -> DatatypeInfo -> [(Name, (Suffix, Var))] -> ConstructorInfo -> WriterT [ExtraDeclOrGenericInfo] Q Exp -handleConstructor options (DatatypeInfo {..}) genericVariables ci = do +handleConstructor :: ExtraTypeScriptOptions -> Options -> DatatypeInfo -> [(Name, (Suffix, Var))] -> ConstructorInfo -> WriterT [ExtraDeclOrGenericInfo] Q Exp +handleConstructor (ExtraTypeScriptOptions {..}) options (DatatypeInfo {..}) genericVariables ci = do if | (length datatypeCons == 1) && not (getTagSingleConstructors options) -> do writeSingleConstructorEncoding brackets <- lift $ getBracketsExpression False genericVariables @@ -290,12 +289,11 @@ handleConstructor options (DatatypeInfo {..}) genericVariables ci = do #if MIN_VERSION_aeson(0,10,0) | unwrapUnaryRecords options && (isSingleRecordConstructor ci) -> do let [typ] = constructorFields ci - stringExp <- lift $ case typ of - (AppT (ConT name) t) | name == ''Maybe && not (omitNothingFields options) -> [|$(getTypeAsStringExp t) <> " | null"|] - _ -> getTypeAsStringExp typ + stringExp <- lift $ [|getTypeScriptTypeOrOptionalNull (Proxy :: Proxy $(return typ))|] alternatives <- lift [|TSTypeAlternatives $(TH.stringE interfaceName) $(genericVariablesListExpr True genericVariables) - [$(return stringExp)]|] + [$(return stringExp)] + $(tryGetDoc haddockModifier (constructorName ci))|] tell [ExtraDecl alternatives] #endif @@ -307,29 +305,28 @@ handleConstructor options (DatatypeInfo {..}) genericVariables ci = do -- * Type declaration to use interfaceName = "I" <> (lastNameComponent' $ constructorName ci) - tupleEncoding = + tupleEncoding = do + let typ = contentsTupleTypeSubstituted genericVariables ci + stringExp <- lift $ [|getTypeScriptTypeOrOptionalNull (Proxy :: Proxy $(return typ))|] + lift [|TSTypeAlternatives $(TH.stringE interfaceName) $(genericVariablesListExpr True genericVariables) - [getTypeScriptType (Proxy :: Proxy $(return (contentsTupleTypeSubstituted genericVariables ci)))]|] + [$(return stringExp)] + $(tryGetDoc haddockModifier (constructorName ci))|] assembleInterfaceDeclaration members = [|TSInterfaceDeclaration $(TH.stringE interfaceName) $(genericVariablesListExpr True genericVariables) - $(return members)|] + $(return members) + $(tryGetDoc haddockModifier (constructorName ci))|] getTSFields :: WriterT [ExtraDeclOrGenericInfo] Q [Exp] getTSFields = forM (namesAndTypes options genericVariables ci) $ \(name, nameString, typ) -> do (fieldTyp, optAsBool) <- lift $ case typ of - (AppT (ConT name) t) | name == ''Maybe && not (omitNothingFields options) -> + (AppT (ConT name') t) | name' == ''Maybe && not (omitNothingFields options) -> ( , ) <$> [|$(getTypeAsStringExp t) <> " | null"|] <*> getOptionalAsBoolExp t _ -> ( , ) <$> getTypeAsStringExp typ <*> getOptionalAsBoolExp typ -#if MIN_VERSION_template_haskell(2,18,0) - maybeDoc <- lift $ nothingOnFail $ getDoc (DeclDoc name) -#else - let maybeDoc = Nothing -#endif - - lift [| TSField $(return optAsBool) $(TH.stringE nameString) $(return fieldTyp) $(case maybeDoc of Just (Just doc) -> [|Just $(TH.stringE doc)|]; _ -> [|Nothing|]) |] + lift [| TSField $(return optAsBool) $(TH.stringE nameString) $(return fieldTyp) $(tryGetDoc haddockModifier name) |] isSingleRecordConstructor (constructorVariant -> RecordConstructor [_]) = True isSingleRecordConstructor _ = False diff --git a/src/Data/Aeson/TypeScript/Transform.hs b/src/Data/Aeson/TypeScript/Transform.hs index 259267a..7e02879 100644 --- a/src/Data/Aeson/TypeScript/Transform.hs +++ b/src/Data/Aeson/TypeScript/Transform.hs @@ -1,17 +1,8 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE MultiWayIf #-} -{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE PolyKinds #-} -{-# LANGUAGE LambdaCase #-} module Data.Aeson.TypeScript.Transform ( @@ -54,7 +45,9 @@ transformTypeFamilies eo@(ExtraTypeScriptOptions {..}) (AppT (ConT name) typ) name' <- lift $ newName (nameBase typeFamilyName <> "'") f <- lift $ newName "f" -#if MIN_VERSION_template_haskell(2,17,0) +#if MIN_VERSION_template_haskell(2,21,0) + let inst1 = DataD [] name' [PlainTV f BndrReq] Nothing [] [] +#elif MIN_VERSION_template_haskell(2,17,0) let inst1 = DataD [] name' [PlainTV f ()] Nothing [] [] #else let inst1 = DataD [] name' [PlainTV f] Nothing [] [] diff --git a/src/Data/Aeson/TypeScript/TypeManipulation.hs b/src/Data/Aeson/TypeScript/TypeManipulation.hs index dc36c11..9462d49 100644 --- a/src/Data/Aeson/TypeScript/TypeManipulation.hs +++ b/src/Data/Aeson/TypeScript/TypeManipulation.hs @@ -1,17 +1,8 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE MultiWayIf #-} -{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE PolyKinds #-} -{-# LANGUAGE LambdaCase #-} module Data.Aeson.TypeScript.TypeManipulation ( searchForConstraints diff --git a/src/Data/Aeson/TypeScript/Types.hs b/src/Data/Aeson/TypeScript/Types.hs index c42af91..910ec73 100644 --- a/src/Data/Aeson/TypeScript/Types.hs +++ b/src/Data/Aeson/TypeScript/Types.hs @@ -1,8 +1,4 @@ -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE StandaloneDeriving #-} @@ -11,9 +7,11 @@ module Data.Aeson.TypeScript.Types where import qualified Data.Aeson as A import Data.Aeson.TypeScript.LegalName +import Data.Function ((&)) import qualified Data.List.NonEmpty as NonEmpty import Data.Proxy import Data.String +import qualified Data.Text as T import Data.Typeable import Language.Haskell.TH @@ -72,6 +70,12 @@ class (Typeable a) => TypeScript a where -- ^ Special flag to indicate whether this type corresponds to a template variable. isGenericVariable _ = False + +getTypeScriptTypeOrOptionalNull :: TypeScript a => Proxy a -> String +getTypeScriptTypeOrOptionalNull proxy = getTypeScriptType proxy <> extra + where + extra = if getTypeScriptOptional proxy then " | null" else "" + -- | An existential wrapper for any TypeScript instance. data TSType = forall a. (Typeable a, TypeScript a) => TSType { unTSType :: Proxy a } @@ -86,10 +90,12 @@ instance Show TSType where data TSDeclaration = TSInterfaceDeclaration { interfaceName :: String , interfaceGenericVariables :: [String] - , interfaceMembers :: [TSField] } + , interfaceMembers :: [TSField] + , interfaceDoc :: Maybe String } | TSTypeAlternatives { typeName :: String , typeGenericVariables :: [String] - , alternativeTypes :: [String]} + , alternativeTypes :: [String] + , typeDoc :: Maybe String } | TSRawDeclaration { text :: String } deriving (Show, Eq, Ord) @@ -202,11 +208,24 @@ allStarConstructors'' = ["T1", "T2", "T3", "T4", "T5", "T6", "T7", "T8", "T9", " data ExtraTypeScriptOptions = ExtraTypeScriptOptions { typeFamiliesToMapToTypeScript :: [Name] + , keyType :: Maybe String + + -- | Function which is applied to all Haddocks we read in. + -- By default, just drops leading whitespace from each line. + , haddockModifier :: String -> String } defaultExtraTypeScriptOptions :: ExtraTypeScriptOptions -defaultExtraTypeScriptOptions = ExtraTypeScriptOptions [] Nothing +defaultExtraTypeScriptOptions = ExtraTypeScriptOptions [] Nothing stripStartEachLine + where + stripStartEachLine :: String -> String + stripStartEachLine s = s + & T.pack + & T.splitOn "\n" + & fmap T.stripStart + & T.intercalate "\n" + & T.unpack data ExtraDeclOrGenericInfo = ExtraDecl Exp | ExtraGeneric GenericInfo diff --git a/src/Data/Aeson/TypeScript/Util.hs b/src/Data/Aeson/TypeScript/Util.hs index 74b2c29..29bff97 100644 --- a/src/Data/Aeson/TypeScript/Util.hs +++ b/src/Data/Aeson/TypeScript/Util.hs @@ -1,14 +1,7 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE MultiWayIf #-} -{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE PolyKinds #-} module Data.Aeson.TypeScript.Util where @@ -19,6 +12,7 @@ import Data.Aeson.TypeScript.Instances () import Data.Aeson.TypeScript.Types import qualified Data.List as L import Data.Proxy +import Data.String (IsString) import Data.String.Interpolate import qualified Data.Text as T import Language.Haskell.TH hiding (stringE) @@ -89,12 +83,12 @@ getTypeAsStringExp typ = [|getTypeScriptType (Proxy :: Proxy $(return typ))|] getOptionalAsBoolExp :: Type -> Q Exp getOptionalAsBoolExp typ = [|getTypeScriptOptional (Proxy :: Proxy $(return typ))|] --- | Helper to apply a type constructor to a list of type args +-- | 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 +-- | Apply a function to a list of args applyToArgsE :: Exp -> [Exp] -> Exp applyToArgsE f [] = f applyToArgsE f (x:xs) = applyToArgsE (AppE f x) xs @@ -190,6 +184,7 @@ mapType g (ImplicitParamT x typ) = ImplicitParamT x (mapType g typ) #endif mapType _ x = x +tryPromote :: (Eq a1, Eq a2, IsString a2) => Type -> [(a1, (a3, a2))] -> a1 -> Type tryPromote _ genericVariables (flip L.lookup genericVariables -> Just (_, "")) = ConT ''T tryPromote _ genericVariables (flip L.lookup genericVariables -> Just (_, "T")) = ConT ''T tryPromote _ genericVariables (flip L.lookup genericVariables -> Just (_, "T1")) = ConT ''T1 @@ -227,3 +222,17 @@ isStarType _ = Nothing nothingOnFail :: Q a -> Q (Maybe a) nothingOnFail action = recover (return Nothing) (Just <$> action) + +tryGetDoc :: (String -> String) -> Name -> Q Exp +tryGetDoc haddockModifier n = do +#if MIN_VERSION_template_haskell(2,18,0) + maybeDoc <- nothingOnFail (getDoc (DeclDoc n)) >>= \case + Just (Just doc) -> return $ Just $ Just $ haddockModifier doc + x -> return x +#else + let maybeDoc = Nothing +#endif + + case maybeDoc of + Just (Just doc) -> [|Just $(TH.stringE doc)|] + _ -> [|Nothing|] diff --git a/stack-8.10.7.yaml b/stack-8.10.7.yaml new file mode 100644 index 0000000..2b383ea --- /dev/null +++ b/stack-8.10.7.yaml @@ -0,0 +1,5 @@ + +resolver: lts-18.28 + +packages: +- . diff --git a/stack-8.10.7.yaml.lock b/stack-8.10.7.yaml.lock new file mode 100644 index 0000000..da10c3e --- /dev/null +++ b/stack-8.10.7.yaml.lock @@ -0,0 +1,12 @@ +# This file was autogenerated by Stack. +# You should not edit this file by hand. +# For more information, please see the documentation at: +# https://docs.haskellstack.org/en/stable/lock_files + +packages: [] +snapshots: +- completed: + sha256: 428ec8d5ce932190d3cbe266b9eb3c175cd81e984babf876b64019e2cbe4ea68 + size: 590100 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/28.yaml + original: lts-18.28 diff --git a/stack-9.0.2.yaml b/stack-9.0.2.yaml new file mode 100644 index 0000000..fe2c91a --- /dev/null +++ b/stack-9.0.2.yaml @@ -0,0 +1,5 @@ + +resolver: lts-19.33 + +packages: +- . diff --git a/stack-9.0.2.yaml.lock b/stack-9.0.2.yaml.lock new file mode 100644 index 0000000..d79c369 --- /dev/null +++ b/stack-9.0.2.yaml.lock @@ -0,0 +1,12 @@ +# This file was autogenerated by Stack. +# You should not edit this file by hand. +# For more information, please see the documentation at: +# https://docs.haskellstack.org/en/stable/lock_files + +packages: [] +snapshots: +- completed: + sha256: 6d1532d40621957a25bad5195bfca7938e8a06d923c91bc52aa0f3c41181f2d4 + size: 619204 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/33.yaml + original: lts-19.33 diff --git a/stack-9.10.2.yaml b/stack-9.10.2.yaml new file mode 100644 index 0000000..09bacd7 --- /dev/null +++ b/stack-9.10.2.yaml @@ -0,0 +1,5 @@ + +resolver: lts-24.2 + +packages: +- . diff --git a/stack-9.10.2.yaml.lock b/stack-9.10.2.yaml.lock new file mode 100644 index 0000000..8e22df7 --- /dev/null +++ b/stack-9.10.2.yaml.lock @@ -0,0 +1,12 @@ +# This file was autogenerated by Stack. +# You should not edit this file by hand. +# For more information, please see the documentation at: +# https://docs.haskellstack.org/en/stable/topics/lock_files + +packages: [] +snapshots: +- completed: + sha256: cd28bd74375205718f1d5fa221730a9c17a203059708b1eb95f4b20d68bf82d9 + size: 724943 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/24/2.yaml + original: lts-24.2 diff --git a/stack-9.12.2.yaml b/stack-9.12.2.yaml new file mode 100644 index 0000000..b026e0d --- /dev/null +++ b/stack-9.12.2.yaml @@ -0,0 +1,10 @@ + +resolver: nightly-2025-07-31 + +nix: + enable: false + +system-ghc: true + +packages: +- . diff --git a/stack-9.12.2.yaml.lock b/stack-9.12.2.yaml.lock new file mode 100644 index 0000000..76ec781 --- /dev/null +++ b/stack-9.12.2.yaml.lock @@ -0,0 +1,12 @@ +# This file was autogenerated by Stack. +# You should not edit this file by hand. +# For more information, please see the documentation at: +# https://docs.haskellstack.org/en/stable/topics/lock_files + +packages: [] +snapshots: +- completed: + sha256: 3dec7f4c6dc2dc10047d2941a6bc9ee8fa6a84f6db932096cbd83a0ace83dfa1 + size: 672916 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/nightly/2025/7/31.yaml + original: nightly-2025-07-31 diff --git a/stack-9.2.8.yaml b/stack-9.2.8.yaml new file mode 100644 index 0000000..028d2f7 --- /dev/null +++ b/stack-9.2.8.yaml @@ -0,0 +1,5 @@ + +resolver: lts-20.26 + +packages: +- . diff --git a/stack-9.2.8.yaml.lock b/stack-9.2.8.yaml.lock new file mode 100644 index 0000000..ea5a850 --- /dev/null +++ b/stack-9.2.8.yaml.lock @@ -0,0 +1,12 @@ +# This file was autogenerated by Stack. +# You should not edit this file by hand. +# For more information, please see the documentation at: +# https://docs.haskellstack.org/en/stable/lock_files + +packages: [] +snapshots: +- completed: + sha256: 5a59b2a405b3aba3c00188453be172b85893cab8ebc352b1ef58b0eae5d248a2 + size: 650475 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/26.yaml + original: lts-20.26 diff --git a/stack-9.4.8.yaml b/stack-9.4.8.yaml new file mode 100644 index 0000000..8ff6e94 --- /dev/null +++ b/stack-9.4.8.yaml @@ -0,0 +1,5 @@ + +resolver: lts-21.25 + +packages: +- . diff --git a/stack-9.4.8.yaml.lock b/stack-9.4.8.yaml.lock new file mode 100644 index 0000000..f823d29 --- /dev/null +++ b/stack-9.4.8.yaml.lock @@ -0,0 +1,12 @@ +# This file was autogenerated by Stack. +# You should not edit this file by hand. +# For more information, please see the documentation at: +# https://docs.haskellstack.org/en/stable/lock_files + +packages: [] +snapshots: +- completed: + sha256: a81fb3877c4f9031e1325eb3935122e608d80715dc16b586eb11ddbff8671ecd + size: 640086 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/21/25.yaml + original: lts-21.25 diff --git a/stack-9.6.3.yaml.lock b/stack-9.6.3.yaml.lock new file mode 100644 index 0000000..1b74b0a --- /dev/null +++ b/stack-9.6.3.yaml.lock @@ -0,0 +1,12 @@ +# This file was autogenerated by Stack. +# You should not edit this file by hand. +# For more information, please see the documentation at: +# https://docs.haskellstack.org/en/stable/lock_files + +packages: [] +snapshots: +- completed: + sha256: 1b4c2669e26fa828451830ed4725e4d406acc25a1fa24fcc039465dd13d7a575 + size: 714100 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/22/6.yaml + original: lts-22.6 diff --git a/stack-9.6.7.yaml b/stack-9.6.7.yaml new file mode 100644 index 0000000..e06d1e2 --- /dev/null +++ b/stack-9.6.7.yaml @@ -0,0 +1,5 @@ + +resolver: lts-22.44 + +packages: +- . diff --git a/stack-9.6.7.yaml.lock b/stack-9.6.7.yaml.lock new file mode 100644 index 0000000..8d134eb --- /dev/null +++ b/stack-9.6.7.yaml.lock @@ -0,0 +1,12 @@ +# This file was autogenerated by Stack. +# You should not edit this file by hand. +# For more information, please see the documentation at: +# https://docs.haskellstack.org/en/stable/topics/lock_files + +packages: [] +snapshots: +- completed: + sha256: 238fa745b64f91184f9aa518fe04bdde6552533d169b0da5256670df83a0f1a9 + size: 721141 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/22/44.yaml + original: lts-22.44 diff --git a/stack-9.8.4.yaml b/stack-9.8.4.yaml new file mode 100644 index 0000000..8587184 --- /dev/null +++ b/stack-9.8.4.yaml @@ -0,0 +1,5 @@ + +resolver: lts-23.7 + +packages: +- . diff --git a/stack-9.8.4.yaml.lock b/stack-9.8.4.yaml.lock new file mode 100644 index 0000000..0e99322 --- /dev/null +++ b/stack-9.8.4.yaml.lock @@ -0,0 +1,12 @@ +# This file was autogenerated by Stack. +# You should not edit this file by hand. +# For more information, please see the documentation at: +# https://docs.haskellstack.org/en/stable/lock_files + +packages: [] +snapshots: +- completed: + sha256: 4ef79c30b9efcf07335cb3de532983a7ac4c5a4180bc17f6212a86b09ce2ff75 + size: 680777 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/23/7.yaml + original: lts-23.7 diff --git a/stack.yaml b/stack.yaml index 812491d..b026e0d 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,8 +1,10 @@ -resolver: lts-20.12 +resolver: nightly-2025-07-31 + +nix: + enable: false + +system-ghc: true packages: - . - -# ghc-options: -# "$locals": -fwrite-ide-info diff --git a/stack.yaml.lock b/stack.yaml.lock index b1d5d3a..76ec781 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -1,12 +1,12 @@ # This file was autogenerated by Stack. # You should not edit this file by hand. # For more information, please see the documentation at: -# https://docs.haskellstack.org/en/stable/lock_files +# https://docs.haskellstack.org/en/stable/topics/lock_files packages: [] snapshots: - completed: - sha256: af5d667f6096e535b9c725a72cffe0f6c060e0568d9f9eeda04caee70d0d9d2d - size: 649133 - url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/12.yaml - original: lts-20.12 + sha256: 3dec7f4c6dc2dc10047d2941a6bc9ee8fa6a84f6db932096cbd83a0ace83dfa1 + size: 672916 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/nightly/2025/7/31.yaml + original: nightly-2025-07-31 diff --git a/test/Basic.hs b/test/Basic.hs index eec08ea..a8abb3e 100644 --- a/test/Basic.hs +++ b/test/Basic.hs @@ -22,15 +22,9 @@ tests = describe "Basic tests" $ do describe "tagSingleConstructors and constructorTagModifier" $ do it [i|Works with a normal unit|] $ do (getTypeScriptDeclarations (Proxy :: Proxy Unit1)) `shouldBe` ([ - TSTypeAlternatives "Unit1" [] ["IUnit1"] - , TSTypeAlternatives "IUnit1" [] ["void[]"] + TSTypeAlternatives "Unit1" [] ["IUnit1"] Nothing + , TSTypeAlternatives "IUnit1" [] ["void[]"] Nothing ]) - it [i|Works with a unit with constructorTagModifier|] $ do - (getTypeScriptDeclarations (Proxy :: Proxy Unit2)) `shouldBe` ([ - TSTypeAlternatives "Unit2" [] ["\"foo\""] - ]) - - main :: IO () main = hspec tests diff --git a/test/ClosedTypeFamilies.hs b/test/ClosedTypeFamilies.hs index d8381db..0e75647 100644 --- a/test/ClosedTypeFamilies.hs +++ b/test/ClosedTypeFamilies.hs @@ -43,20 +43,20 @@ tests = describe "Closed type families" $ do TSField False "\"k8s_env\"" "\"k8s\"" Nothing , TSField False "\"single_node_env\"" "\"single\"" Nothing , TSField False "T" "void" Nothing - ] - , TSTypeAlternatives "ISimple" ["T extends keyof DeployEnvironment2"] ["DeployEnvironment2[T]"] - , TSTypeAlternatives "Simple" ["T extends keyof DeployEnvironment2"] ["ISimple"] + ] Nothing + , TSTypeAlternatives "ISimple" ["T extends keyof DeployEnvironment2"] ["DeployEnvironment2[T]"] Nothing + , TSTypeAlternatives "Simple" ["T extends keyof DeployEnvironment2"] ["ISimple"] Nothing ]) describe "Complicated Beam-like user type" $ do it [i|makes the declaration and types correctly|] $ do (getTypeScriptDeclarations (Proxy :: Proxy (UserT T Identity))) `shouldBe` ([ - TSTypeAlternatives "UserT" ["T extends keyof DeployEnvironment"] ["IUser"] + TSTypeAlternatives "UserT" ["T extends keyof DeployEnvironment"] ["IUser"] Nothing , TSInterfaceDeclaration "IUser" ["T extends keyof DeployEnvironment"] [ TSField False "_userUsername" "string" Nothing , TSField False "_userCreatedAt" "number" Nothing , TSField False "_userDeployEnvironment" "DeployEnvironment[T]" Nothing - ] + ] Nothing ]) it [i|get the declarations recursively|] $ do @@ -65,13 +65,13 @@ tests = describe "Closed type families" $ do TSField False "\"k8s_env\"" "\"k8s\"" Nothing , TSField False "\"single_node_env\"" "\"single\"" Nothing , TSField False "T" "void" Nothing - ] + ] Nothing , TSInterfaceDeclaration "IUser" ["T extends keyof DeployEnvironment"] [ TSField False "_userUsername" "string" Nothing , TSField False "_userCreatedAt" "number" Nothing , TSField False "_userDeployEnvironment" "DeployEnvironment[T]" Nothing - ] - , TSTypeAlternatives "UserT" ["T extends keyof DeployEnvironment"] ["IUser"] + ] Nothing + , TSTypeAlternatives "UserT" ["T extends keyof DeployEnvironment"] ["IUser"] Nothing ]) main :: IO () diff --git a/test/Formatting.hs b/test/Formatting.hs index c4fec32..a86f948 100644 --- a/test/Formatting.hs +++ b/test/Formatting.hs @@ -1,9 +1,10 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE TypeApplications #-} module Formatting (tests) where import Control.Exception -import Data.Aeson (defaultOptions) +import Data.Aeson (SumEncoding(UntaggedValue), defaultOptions, sumEncoding, tagSingleConstructors) import Data.Aeson.TypeScript.TH import Data.Proxy import Data.String.Interpolate @@ -13,36 +14,97 @@ import Test.Hspec data D = S | F deriving (Eq, Show) $(deriveTypeScript defaultOptions ''D) +data D2 = S2 | F2 deriving (Eq, Show) +$(deriveTypeScript defaultOptions ''D2) + +-- A.encode U --> "[]" +data Unit = U deriving (Eq, Show) +$(deriveTypeScript defaultOptions ''Unit) + +-- A.encode UTagSingle --> "\"UTagSingle\"" +data UnitTagSingle = UTagSingle deriving (Eq, Show) +$(deriveTypeScript (defaultOptions { tagSingleConstructors = True, sumEncoding = UntaggedValue }) ''UnitTagSingle) + data PrimeInType' = PrimeInType $(deriveTypeScript defaultOptions ''PrimeInType') data PrimeInConstr = PrimeInConstr' $(deriveTypeScript defaultOptions ''PrimeInConstr) +data FooBar = + Foo { + -- | @no-emit-typescript + recordString :: String + , recordInt :: Int + } + | + -- | @no-emit-typescript + Bar { + barInt :: Int + } +$(deriveTypeScript defaultOptions ''FooBar) + +data NormalConstructors = + -- | @no-emit-typescript + Con1 String + | Con2 Int +$(deriveTypeScript defaultOptions ''NormalConstructors) + tests :: Spec -tests = do - describe "Formatting" $ do - describe "when given a Sum Type" $ do - describe "and the TypeAlias format option is set" $ - it "should generate a TS string literal type" $ - formatTSDeclarations' defaultFormattingOptions (getTypeScriptDeclarations @D Proxy) `shouldBe` - [i|type D = "S" | "F";|] - describe "and the Enum format option is set" $ - it "should generate a TS Enum" $ - formatTSDeclarations' (defaultFormattingOptions { typeAlternativesFormat = Enum }) (getTypeScriptDeclarations @D Proxy) `shouldBe` - [i|enum D { S, F }|] - describe "and the EnumWithType format option is set" $ - it "should generate a TS Enum with a type declaration" $ - formatTSDeclarations' (defaultFormattingOptions { typeAlternativesFormat = EnumWithType }) (getTypeScriptDeclarations @D Proxy) `shouldBe` - [i|enum DEnum { S="S", F="F" }\n\ntype D = keyof typeof DEnum;|] - describe "when the name has an apostrophe" $ do - describe "in the type" $ do - it "throws an error" $ do - evaluate (formatTSDeclarations' defaultFormattingOptions (getTypeScriptDeclarations @PrimeInType' Proxy)) - `shouldThrow` - anyErrorCall - describe "in the constructor" $ do - it "throws an error" $ do - evaluate (formatTSDeclarations' defaultFormattingOptions (getTypeScriptDeclarations @PrimeInConstr Proxy)) - `shouldThrow` - anyErrorCall +tests = describe "Formatting" $ do + describe "when given a Sum Type" $ do + describe "and the TypeAlias format option is set" $ + it "should generate a TS string literal type" $ + formatTSDeclarations' defaultFormattingOptions (getTypeScriptDeclarations @D Proxy) `shouldBe` + [i|type D = "S" | "F";|] + + describe "and the Enum format option is set" $ do + it "should generate a TS Enum" $ + formatTSDeclarations' (defaultFormattingOptions { typeAlternativesFormat = Enum }) (getTypeScriptDeclarations @D Proxy) `shouldBe` + [i|enum D { S="S", F="F" }|] + + it "should generate a TS Enum with multiple" $ + formatTSDeclarations' (defaultFormattingOptions { typeAlternativesFormat = Enum }) (getTypeScriptDeclarations @D Proxy <> getTypeScriptDeclarations @D2 Proxy) `shouldBe` + [__i|enum D { S="S", F="F" } + + enum D2 { S2="S2", F2="F2" }|] + + it "should generate a normal type from Unit, singe tagSingleConstructors=False by default" $ + formatTSDeclarations' (defaultFormattingOptions { typeAlternativesFormat = Enum }) (getTypeScriptDeclarations @Unit Proxy) `shouldBe` + [__i|type Unit = IU; + + type IU = void[];|] + + it "should generate a suitable enum from UnitTagSingle" $ + formatTSDeclarations' (defaultFormattingOptions { typeAlternativesFormat = Enum }) (getTypeScriptDeclarations @UnitTagSingle Proxy) `shouldBe` + [__i|enum UnitTagSingle { UTagSingle="UTagSingle" }|] + + describe "and the EnumWithType format option is set" $ do + it "should generate a TS Enum with a type declaration" $ + formatTSDeclarations' (defaultFormattingOptions { typeAlternativesFormat = EnumWithType }) (getTypeScriptDeclarations @D Proxy) `shouldBe` + [i|enum DEnum { S="S", F="F" }\n\ntype D = keyof typeof DEnum;|] + + it "should also work for UnitTagSingle" $ + formatTSDeclarations' (defaultFormattingOptions { typeAlternativesFormat = EnumWithType }) (getTypeScriptDeclarations @UnitTagSingle Proxy) `shouldBe` + [i|enum UnitTagSingleEnum { UTagSingle="UTagSingle" }\n\ntype UnitTagSingle = keyof typeof UnitTagSingleEnum;|] + + describe "when the name has an apostrophe" $ do + describe "in the type" $ do + it "throws an error" $ do + evaluate (formatTSDeclarations' defaultFormattingOptions (getTypeScriptDeclarations @PrimeInType' Proxy)) `shouldThrow` anyErrorCall + + describe "in the constructor" $ do + it "throws an error" $ do + evaluate (formatTSDeclarations' defaultFormattingOptions (getTypeScriptDeclarations @PrimeInConstr Proxy)) `shouldThrow` anyErrorCall + +#if MIN_VERSION_template_haskell(2,18,0) + describe "when @no-emit-typescript is present" $ do + it [i|works on records and constructors of record types|] $ do + formatTSDeclarations' defaultFormattingOptions (getTypeScriptDeclarations @FooBar Proxy) `shouldBe` [i|type FooBar = IFoo;\n\ninterface IFoo {\n tag: "Foo";\n recordInt: number;\n}|] + + it [i|works on normal constructors|] $ do + formatTSDeclarations' defaultFormattingOptions (getTypeScriptDeclarations @NormalConstructors Proxy) `shouldBe` [i|type NormalConstructors = ICon2;\n\ninterface ICon2 {\n tag: "Con2";\n contents: number;\n}|] +#endif + +main :: IO () +main = hspec tests diff --git a/test/Generic.hs b/test/Generic.hs index 889ac8d..ea6d05b 100644 --- a/test/Generic.hs +++ b/test/Generic.hs @@ -29,38 +29,32 @@ tests :: SpecWith () tests = describe "Generic instances" $ do it [i|Complex makes the declaration and types correctly|] $ do (getTypeScriptDeclarationsRecursively (Proxy :: Proxy (Complex String))) `shouldBe` [ - TSInterfaceDeclaration {interfaceName = "IProduct", interfaceGenericVariables = ["T"], interfaceMembers = [TSField False "tag" "\"Product\"" Nothing, TSField False "contents" "[number, T]" Nothing]} - ,TSInterfaceDeclaration {interfaceName = "IUnary", interfaceGenericVariables = ["T"], interfaceMembers = [TSField False "tag" "\"Unary\"" Nothing, TSField False "contents" "number" Nothing]} - ,TSTypeAlternatives {typeName = "Complex", typeGenericVariables = ["T"], alternativeTypes = ["IProduct","IUnary"]} + TSInterfaceDeclaration "IProduct" ["T"] [TSField False "tag" "\"Product\"" Nothing, TSField False "contents" "[number, T]" Nothing] Nothing + ,TSInterfaceDeclaration "IUnary" ["T"] [TSField False "tag" "\"Unary\"" Nothing, TSField False "contents" "number" Nothing] Nothing + ,TSTypeAlternatives "Complex" ["T"] ["IProduct","IUnary"] Nothing ] it [i|Complex2 makes the declaration and types correctly|] $ do (getTypeScriptDeclarationsRecursively (Proxy :: Proxy (Complex2 String))) `shouldBe` [ - TSTypeAlternatives {typeName = "Complex2", typeGenericVariables = ["T"], alternativeTypes = ["IProduct2"]} - ,TSTypeAlternatives {typeName = "IProduct2", typeGenericVariables = ["T"], alternativeTypes = ["[number, T]"]} + TSTypeAlternatives "Complex2" ["T"] ["IProduct2"] Nothing + ,TSTypeAlternatives "IProduct2" ["T"] ["[number, T]"] Nothing ] it [i|Complex3 makes the declaration and types correctly|] $ do (getTypeScriptDeclarationsRecursively (Proxy :: Proxy (Complex3 String))) `shouldBe` [ - TSInterfaceDeclaration {interfaceName = "IProduct3", interfaceGenericVariables = ["T"], interfaceMembers = [ - TSField False "record3" "T[]" Nothing - ]} - ,TSTypeAlternatives {typeName = "Complex3", typeGenericVariables = ["T"], alternativeTypes = ["IProduct3"]} + TSInterfaceDeclaration "IProduct3" ["T"] [TSField False "record3" "T[]" Nothing] Nothing + ,TSTypeAlternatives "Complex3" ["T"] ["IProduct3"] Nothing ] (getTypeScriptDeclarationsRecursively (Proxy :: Proxy (Complex3 Int))) `shouldBe` [ - TSInterfaceDeclaration {interfaceName = "IProduct3", interfaceGenericVariables = ["T"], interfaceMembers = [ - TSField False "record3" "T[]" Nothing - ]} - ,TSTypeAlternatives {typeName = "Complex3", typeGenericVariables = ["T"], alternativeTypes = ["IProduct3"]} + TSInterfaceDeclaration "IProduct3" ["T"] [TSField False "record3" "T[]" Nothing] Nothing + ,TSTypeAlternatives "Complex3" ["T"] ["IProduct3"] Nothing ] it [i|Complex4 makes the declaration and types correctly|] $ do (getTypeScriptDeclarationsRecursively (Proxy :: Proxy (Complex4 String))) `shouldBe` [ - TSInterfaceDeclaration {interfaceName = "IProduct4", interfaceGenericVariables = ["T"], interfaceMembers = [ - TSField False "record4" "{[k in string]?: T}" Nothing - ]} - ,TSTypeAlternatives {typeName = "Complex4", typeGenericVariables = ["T"], alternativeTypes = ["IProduct4"]} + TSInterfaceDeclaration "IProduct4" ["T"] [TSField False "record4" "{[k in string]: T}" Nothing] Nothing + ,TSTypeAlternatives "Complex4" ["T"] ["IProduct4"] Nothing ] main :: IO () diff --git a/test/GetDoc.hs b/test/GetDoc.hs index 0f91f82..73f25b7 100644 --- a/test/GetDoc.hs +++ b/test/GetDoc.hs @@ -10,21 +10,23 @@ import Prelude hiding (Double) import Test.Hspec --- | OneField is a type with a single field -data OneField = OneField { - -- | This is a simple string - simpleString :: String - } +-- | OneField type doc +data OneField = + -- | OneField constructor doc + OneField { + -- | This is a simple string + simpleString :: String + } $(deriveTypeScript A.defaultOptions ''OneField) tests :: SpecWith () tests = describe "getDoc tests" $ do it [i|Works with a simple record type|] $ do (getTypeScriptDeclarations (Proxy :: Proxy OneField)) `shouldBe` ([ - TSTypeAlternatives "OneField" [] ["IOneField"] + TSTypeAlternatives "OneField" [] ["IOneField"] (Just "OneField type doc") , TSInterfaceDeclaration "IOneField" [] [ - TSField False "simpleString" "string" (Just " This is a simple string") - ] + TSField False "simpleString" "string" (Just "This is a simple string") + ] (Just "OneField constructor doc") ]) main :: IO () diff --git a/test/HigherKind.hs b/test/HigherKind.hs index b272ecc..3587785 100644 --- a/test/HigherKind.hs +++ b/test/HigherKind.hs @@ -36,8 +36,8 @@ tests = describe "Higher kinds" $ do describe "Kind * -> *" $ do it [i|makes the declaration and types correctly|] $ do (getTypeScriptDeclarations (Proxy :: Proxy (HigherKind T))) `shouldBe` ([ - TSTypeAlternatives "HigherKind" ["T"] ["IHigherKind"], - TSInterfaceDeclaration "IHigherKind" ["T"] [TSField False "higherKindList" "T[]" Nothing] + TSTypeAlternatives "HigherKind" ["T"] ["IHigherKind"] Nothing, + TSInterfaceDeclaration "IHigherKind" ["T"] [TSField False "higherKindList" "T[]" Nothing] Nothing ]) (getTypeScriptType (Proxy :: Proxy (HigherKind Int))) `shouldBe` "HigherKind" @@ -45,23 +45,23 @@ tests = describe "Higher kinds" $ do it [i|works when referenced in another type|] $ do (getTypeScriptDeclarations (Proxy :: Proxy Foo)) `shouldBe` ([ - TSTypeAlternatives "Foo" [] ["IFoo"], + TSTypeAlternatives "Foo" [] ["IFoo"] Nothing, TSInterfaceDeclaration "IFoo" [] [TSField False "fooString" "string" Nothing - , TSField False "fooHigherKindReference" "HigherKind" Nothing] + , TSField False "fooHigherKindReference" "HigherKind" Nothing] Nothing ]) it [i|works with an interface inside|] $ do (getTypeScriptDeclarations (Proxy :: Proxy (HigherKindWithUnary T))) `shouldBe` ([ - TSTypeAlternatives "HigherKindWithUnary" ["T"] ["IUnary"], - TSTypeAlternatives "IUnary" ["T"] ["number"] + TSTypeAlternatives "HigherKindWithUnary" ["T"] ["IUnary"] Nothing, + TSTypeAlternatives "IUnary" ["T"] ["number"] Nothing ]) describe "Kind * -> * -> *" $ do it [i|makes the declaration and type correctly|] $ do (getTypeScriptDeclarations (Proxy :: Proxy (DoubleHigherKind T1 T2))) `shouldBe` ([ - TSTypeAlternatives "DoubleHigherKind" ["T1","T2"] ["IDoubleHigherKind"], + TSTypeAlternatives "DoubleHigherKind" ["T1","T2"] ["IDoubleHigherKind"] Nothing, TSInterfaceDeclaration "IDoubleHigherKind" ["T1","T2"] [TSField False "someList" "T2[]" Nothing - , TSField False "higherKindThing" "HigherKind" Nothing] + , TSField False "higherKindThing" "HigherKind" Nothing] Nothing ]) (getTypeScriptType (Proxy :: Proxy (DoubleHigherKind Int String))) `shouldBe` "DoubleHigherKind" diff --git a/test/MaybeTuples.hs b/test/MaybeTuples.hs new file mode 100644 index 0000000..d857f97 --- /dev/null +++ b/test/MaybeTuples.hs @@ -0,0 +1,78 @@ + +module MaybeTuples (tests) where + +import Data.Aeson as A +import Data.Aeson.TypeScript.TH +import Data.Aeson.TypeScript.Types +import Data.Proxy +import Data.String.Interpolate +import Prelude hiding (Double) +import Test.Hspec + + +data Maybe1 = Maybe1 (Maybe Int) +deriveTypeScript A.defaultOptions ''Maybe1 + +data Maybe2 = Maybe2 String (Maybe Int) +deriveTypeScript A.defaultOptions ''Maybe2 + +data Maybe3 = Maybe3 String (String, String) (Maybe Int) +deriveTypeScript A.defaultOptions ''Maybe3 + +data Maybe4 = Maybe4 Int Int Int (Maybe Int) +deriveTypeScript A.defaultOptions ''Maybe4 + +data Maybe5 = Maybe5 Int Int Int Int (Maybe Int) +deriveTypeScript A.defaultOptions ''Maybe5 + +data Maybe6 = Maybe6 Int Int Int Int Int (Maybe Int) +deriveTypeScript A.defaultOptions ''Maybe6 + +data MaybeRecord = MaybeRecord { + foo :: String + , bar :: Maybe Int + } +deriveTypeScript A.defaultOptions ''MaybeRecord + +tests :: SpecWith () +tests = describe "Maybes in tuple encodings" $ do + describe "tagSingleConstructors and constructorTagModifier" $ do + it [i|Maybe 1 tuple encoding includes null option|] $ do + (getTypeScriptDeclarations (Proxy :: Proxy Maybe1)) `shouldBe` ([ + TSTypeAlternatives "Maybe1" [] ["IMaybe1"] Nothing + , TSTypeAlternatives "IMaybe1" [] ["number | null"] Nothing + ]) + + it [i|Maybe 2 tuple encoding includes null option|] $ do + (getTypeScriptDeclarations (Proxy :: Proxy Maybe2)) `shouldBe` ([ + TSTypeAlternatives "Maybe2" [] ["IMaybe2"] Nothing + , TSTypeAlternatives "IMaybe2" [] ["[string, number | null]"] Nothing + ]) + + it [i|Maybe 3 tuple encoding includes null option|] $ do + (getTypeScriptDeclarations (Proxy :: Proxy Maybe3)) `shouldBe` ([ + TSTypeAlternatives "Maybe3" [] ["IMaybe3"] Nothing + , TSTypeAlternatives "IMaybe3" [] ["[string, [string, string], number | null]"] Nothing + ]) + + it [i|Maybe 4 tuple encoding includes null option|] $ do + (getTypeScriptDeclarations (Proxy :: Proxy Maybe4)) `shouldBe` ([ + TSTypeAlternatives "Maybe4" [] ["IMaybe4"] Nothing + , TSTypeAlternatives "IMaybe4" [] ["[number, number, number, number | null]"] Nothing + ]) + + it [i|Maybe 5 tuple encoding includes null option|] $ do + (getTypeScriptDeclarations (Proxy :: Proxy Maybe5)) `shouldBe` ([ + TSTypeAlternatives "Maybe5" [] ["IMaybe5"] Nothing + , TSTypeAlternatives "IMaybe5" [] ["[number, number, number, number, number | null]"] Nothing + ]) + + it [i|Maybe 6 tuple encoding includes null option|] $ do + (getTypeScriptDeclarations (Proxy :: Proxy Maybe6)) `shouldBe` ([ + TSTypeAlternatives "Maybe6" [] ["IMaybe6"] Nothing + , TSTypeAlternatives "IMaybe6" [] ["[number, number, number, number, number, number | null]"] Nothing + ]) + + +main :: IO () +main = hspec tests diff --git a/test/NoOmitNothingFields.hs b/test/NoOmitNothingFields.hs index 4f5da71..4dd6dd8 100644 --- a/test/NoOmitNothingFields.hs +++ b/test/NoOmitNothingFields.hs @@ -13,17 +13,9 @@ $(testDeclarations "NoOmitNothingFields" (A.defaultOptions {omitNothingFields = allTests :: SpecWith () allTests = describe "NoOmitNothingFields" $ do it "encodes as expected" $ do - let decls = getTypeScriptDeclarations (Proxy :: Proxy Optional) + let decls = getTypeScriptDeclarations (Proxy :: Proxy OptionalRecord) - decls `shouldBe` [TSTypeAlternatives { - typeName = "Optional" - , typeGenericVariables = [] - , alternativeTypes = ["IOptional"] - } - , TSInterfaceDeclaration { - interfaceName = "IOptional" - , interfaceGenericVariables = [] - , interfaceMembers = [TSField False "optionalInt" "number | null" Nothing] - }] + decls `shouldBe` [TSTypeAlternatives "OptionalRecord" [] ["IOptionalRecord"] Nothing + , TSInterfaceDeclaration "IOptionalRecord" [] [TSField False "optionalInt" "number | null" Nothing] Nothing] tests diff --git a/test/OmitNothingFields.hs b/test/OmitNothingFields.hs index 9993e3b..f418b6f 100644 --- a/test/OmitNothingFields.hs +++ b/test/OmitNothingFields.hs @@ -13,14 +13,15 @@ $(testDeclarations "OmitNothingFields" (A.defaultOptions {omitNothingFields=True main :: IO () main = hspec $ describe "OmitNothingFields" $ do it "encodes as expected" $ do - let decls = getTypeScriptDeclarations (Proxy :: Proxy Optional) + let decls = getTypeScriptDeclarations (Proxy :: Proxy OptionalRecord) decls `shouldBe` [TSInterfaceDeclaration { - interfaceName = "Optional" + interfaceName = "OptionalRecord" , interfaceGenericVariables = [] , interfaceMembers = [ TSField True "optionalInt" "number" Nothing ] + , interfaceDoc = Nothing }] tests diff --git a/test/OpenTypeFamilies.hs b/test/OpenTypeFamilies.hs index f668757..52a148e 100644 --- a/test/OpenTypeFamilies.hs +++ b/test/OpenTypeFamilies.hs @@ -43,20 +43,20 @@ tests = describe "Open type families" $ do TSField False "\"single_node_env\"" "\"single\"" Nothing , TSField False "\"k8s_env\"" "\"k8s\"" Nothing , TSField False "T" "void" Nothing - ] - , TSTypeAlternatives "ISimple" ["T extends keyof DeployEnvironment2"] ["DeployEnvironment2[T]"] - , TSTypeAlternatives "Simple" ["T extends keyof DeployEnvironment2"] ["ISimple"] + ] Nothing + , TSTypeAlternatives "ISimple" ["T extends keyof DeployEnvironment2"] ["DeployEnvironment2[T]"] Nothing + , TSTypeAlternatives "Simple" ["T extends keyof DeployEnvironment2"] ["ISimple"] Nothing ]) describe "Complicated Beam-like user type" $ do it [i|makes the declaration and types correctly|] $ do (getTypeScriptDeclarations (Proxy :: Proxy (UserT T Identity))) `shouldBe` ([ - TSTypeAlternatives "UserT" ["T extends keyof DeployEnvironment"] ["IUser"] + TSTypeAlternatives "UserT" ["T extends keyof DeployEnvironment"] ["IUser"] Nothing , TSInterfaceDeclaration "IUser" ["T extends keyof DeployEnvironment"] [ TSField False "_userUsername" "string" Nothing , TSField False "_userCreatedAt" "number" Nothing , TSField False "_userDeployEnvironment" "DeployEnvironment[T]" Nothing - ] + ] Nothing ]) it [i|get the declarations recursively|] $ do @@ -65,13 +65,13 @@ tests = describe "Open type families" $ do TSField False "\"single_node_env\"" "\"single\"" Nothing , TSField False "\"k8s_env\"" "\"k8s\"" Nothing , TSField False "T" "void" Nothing - ] + ] Nothing , TSInterfaceDeclaration "IUser" ["T extends keyof DeployEnvironment"] [ TSField False "_userUsername" "string" Nothing , TSField False "_userCreatedAt" "number" Nothing , TSField False "_userDeployEnvironment" "DeployEnvironment[T]" Nothing - ] - , TSTypeAlternatives "UserT" ["T extends keyof DeployEnvironment"] ["IUser"] + ] Nothing + , TSTypeAlternatives "UserT" ["T extends keyof DeployEnvironment"] ["IUser"] Nothing ]) main :: IO () diff --git a/test/Spec.hs b/test/Spec.hs index d7f7548..11e0626 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -5,11 +5,12 @@ module Main where import Test.Hspec import qualified Basic +import qualified ClosedTypeFamilies import qualified Formatting import qualified Generic import qualified GetDoc import qualified HigherKind -import qualified ClosedTypeFamilies +import qualified MaybeTuples import qualified LegalNameSpec import qualified NoOmitNothingFields @@ -35,6 +36,7 @@ main = hspec $ parallel $ do GetDoc.tests #endif HigherKind.tests + MaybeTuples.tests LegalNameSpec.tests NoOmitNothingFields.allTests diff --git a/test/TestBoilerplate.hs b/test/TestBoilerplate.hs index ac4afd0..bd4bd92 100644 --- a/test/TestBoilerplate.hs +++ b/test/TestBoilerplate.hs @@ -6,11 +6,17 @@ 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.Functor.Compose +import Data.Functor.Const import Data.Functor.Identity +import Data.Functor.Product import Data.Kind +import Data.List.NonEmpty import Data.Proxy import Data.String.Interpolate +import Data.Word import Language.Haskell.TH hiding (Type) +import Numeric.Natural (Natural) import Test.Hspec import Util import Util.Aeson @@ -23,8 +29,28 @@ 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 -data Optional = Optional {optionalInt :: Maybe Int} +data OptionalRecord = OptionalRecord {optionalInt :: Maybe Int} +data OptionalTuple1 = OptionalTuple1 (Maybe Int) +data OptionalTuple2 = OptionalTuple2 String (Maybe Int) data AesonTypes = AesonTypes { aesonValue :: A.Value, aesonObject :: A.Object } +data Numbers = Numbers { + natural :: Natural + , word :: Word + , word16 :: Word16 + , word32 :: Word32 + , word64 :: Word64 + } +data FancyFunctors = FancyFunctors { + nonEmpty :: NonEmpty Int + , const :: Const Int Int + , product :: Product Identity Identity Int + , compose :: Compose Identity Identity Int + } + +-- * Values + +fancyFunctorsValue :: FancyFunctors +fancyFunctorsValue = FancyFunctors (42 :| []) (Const 42) (Pair 42 42) (Compose 42) -- * For testing type families @@ -63,8 +89,12 @@ testDeclarations testName aesonOptions = do deriveInstances ''Hybrid deriveInstances ''TwoConstructor deriveInstances ''Complex - deriveInstances ''Optional + deriveInstances ''OptionalRecord + deriveInstances ''OptionalTuple1 + deriveInstances ''OptionalTuple2 deriveInstances ''AesonTypes + deriveInstances ''Numbers + deriveInstances ''FancyFunctors typesAndValues :: Exp <- [e|[(getTypeScriptType (Proxy :: Proxy Unit), A.encode Unit) @@ -87,13 +117,22 @@ testDeclarations testName aesonOptions = do , (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)) - , (getTypeScriptType (Proxy :: Proxy Optional), A.encode (Optional { optionalInt = Nothing })) - , (getTypeScriptType (Proxy :: Proxy Optional), A.encode (Optional { optionalInt = Just 1 })) + , (getTypeScriptType (Proxy :: Proxy OptionalRecord), A.encode (OptionalRecord { optionalInt = Nothing })) + , (getTypeScriptType (Proxy :: Proxy OptionalRecord), A.encode (OptionalRecord { optionalInt = Just 1 })) + + , (getTypeScriptType (Proxy :: Proxy OptionalTuple1), A.encode (OptionalTuple1 Nothing)) + , (getTypeScriptType (Proxy :: Proxy OptionalTuple1), A.encode (OptionalTuple1 (Just 1))) + + , (getTypeScriptType (Proxy :: Proxy OptionalTuple2), A.encode (OptionalTuple2 "asdf" Nothing)) + , (getTypeScriptType (Proxy :: Proxy OptionalTuple2), A.encode (OptionalTuple2 "asdf" (Just 1))) , (getTypeScriptType (Proxy :: Proxy AesonTypes), A.encode (AesonTypes { - aesonValue = A.object [("foo" :: A.Key, A.Number 42)] + aesonValue = A.object [("foo" :: AesonKey, A.Number 42)] , aesonObject = aesonFromList [("foo", A.Number 42)] })) + + , (getTypeScriptType (Proxy :: Proxy Numbers), A.encode (Numbers 42 42 42 42 42)) + , (getTypeScriptType (Proxy :: Proxy FancyFunctors), A.encode fancyFunctorsValue) ]|] declarations :: Exp <- [e|getTypeScriptDeclarations (Proxy :: Proxy Unit) @@ -104,8 +143,12 @@ testDeclarations testName aesonOptions = do <> getTypeScriptDeclarations (Proxy :: Proxy Hybrid) <> getTypeScriptDeclarations (Proxy :: Proxy TwoConstructor) <> getTypeScriptDeclarations (Proxy :: Proxy (Complex T)) - <> getTypeScriptDeclarations (Proxy :: Proxy Optional) + <> getTypeScriptDeclarations (Proxy :: Proxy OptionalRecord) + <> getTypeScriptDeclarations (Proxy :: Proxy OptionalTuple1) + <> getTypeScriptDeclarations (Proxy :: Proxy OptionalTuple2) <> getTypeScriptDeclarations (Proxy :: Proxy AesonTypes) + <> getTypeScriptDeclarations (Proxy :: Proxy Numbers) + <> getTypeScriptDeclarations (Proxy :: Proxy FancyFunctors) |] tests <- [d|tests :: SpecWith () diff --git a/test/UnwrapUnaryRecords.hs b/test/UnwrapUnaryRecords.hs index 99c702d..1a75fb2 100644 --- a/test/UnwrapUnaryRecords.hs +++ b/test/UnwrapUnaryRecords.hs @@ -19,8 +19,8 @@ allTests = describe "UnwrapUnaryRecords" $ do let decls = getTypeScriptDeclarations (Proxy :: Proxy OneField) decls `shouldBe` [ - TSTypeAlternatives {typeName = "OneField", typeGenericVariables = [], alternativeTypes = ["IOneField"]} - ,TSTypeAlternatives {typeName = "IOneField", typeGenericVariables = [], alternativeTypes = ["string"]} + TSTypeAlternatives "OneField" [] ["IOneField"] Nothing + ,TSTypeAlternatives "IOneField" [] ["string"] Nothing ] tests diff --git a/test/Util.hs b/test/Util.hs index 180f657..045672f 100644 --- a/test/Util.hs +++ b/test/Util.hs @@ -1,6 +1,11 @@ {-# LANGUAGE CPP #-} -module Util where +module Util ( + testTypeCheck + , testTypeCheckDeclarations + + , setTagSingleConstructors + ) where import Control.Monad import Data.Aeson as A @@ -14,12 +19,12 @@ import System.Environment import System.Exit import System.FilePath import System.IO.Temp -import System.Process +import System.Process hiding (cwd) + -npmInstallScript, yarnInstallScript, localTSC :: String +npmInstallScript, yarnInstallScript :: String npmInstallScript = "test/assets/npm_install.sh" yarnInstallScript = "test/assets/yarn_install.sh" -localTSC = "test/assets/node_modules/.bin/tsc" isCI :: IO Bool isCI = lookupEnv "CI" >>= (return . (== (Just "true"))) @@ -29,8 +34,22 @@ getTSC = isCI >>= \case True -> do return "tsc" -- Assume it's set up on the path False -> do - ensureTSCExists - return localTSC + -- Check for a global tsc + findExecutable "tsc" >>= \case + Just tsc -> return tsc + Nothing -> do + let localTSC = "test/assets/node_modules/.bin/tsc" + + doesFileExist localTSC >>= \exists -> unless exists $ void $ do + cwd <- getCurrentDirectory + + installScript <- chooseInstallScript + + putStrLn [i|Invoking yarn to install tsc compiler (make sure yarn is installed). CWD is #{cwd}|] + (exitCode, stdout, stderr) <- readProcessWithExitCode installScript [] "" + when (exitCode /= ExitSuccess) $ putStrLn [i|Error installing yarn: '#{stderr}', '#{stdout}'|] + + return localTSC testTypeCheck :: forall a. (TypeScript a, ToJSON a) => a -> IO () testTypeCheck obj = withSystemTempDirectory "typescript_test" $ \folder -> do @@ -69,24 +88,19 @@ testTypeCheckDeclarations tsDeclarations typesAndVals = withSystemTempDirectory writeFile tsFile contents tsc <- getTSC - (code, output, _err) <- readProcessWithExitCode tsc ["--strict", "--noEmit", "--skipLibCheck", "--traceResolution", "--noResolve", tsFile] "" - - when (code /= ExitSuccess) $ do - error [i|TSC check failed: #{output}. File contents were\n\n#{contents}|] - - return () - - -ensureTSCExists :: IO () -ensureTSCExists = doesFileExist localTSC >>= \exists -> unless exists $ void $ do - cwd <- getCurrentDirectory + (code, sout, serr) <- readProcessWithExitCode tsc ["--strict", "--noEmit", "--skipLibCheck", "--traceResolution", "--noResolve", tsFile] "" - installScript <- chooseInstallScript + when (code /= ExitSuccess) $ + error [__i|TSC check failed. + File contents: + #{contents} - putStrLn [i|Invoking yarn to install tsc compiler (make sure yarn is installed). CWD is #{cwd}|] - (exitCode, stdout, stderr) <- readProcessWithExitCode installScript [] "" - when (exitCode /= ExitSuccess) $ putStrLn [i|Error installing yarn: '#{stderr}', '#{stdout}'|] + Stdout: + #{sout} + Stderr: + #{serr} + |] -- Between Aeson 1.1.2.0 and 1.2.0.0, tagSingleConstructors was added setTagSingleConstructors :: Options -> Options diff --git a/test/Util/Aeson.hs b/test/Util/Aeson.hs index b38b900..38aded1 100644 --- a/test/Util/Aeson.hs +++ b/test/Util/Aeson.hs @@ -8,8 +8,15 @@ import qualified Data.Aeson.KeyMap as KM aesonFromList :: [(K.Key, v)] -> KM.KeyMap v aesonFromList = KM.fromList + +type AesonKey = K.Key #else +import Data.Aeson as A import Data.HashMap.Strict as HM +import Data.Text as T +aesonFromList :: [(T.Text, Value)] -> HM.HashMap Text A.Value aesonFromList = HM.fromList + +type AesonKey = Text #endif