433713f...master · jrec

.github/workflows/ci.yaml+7−13

since splitsnapshots

unifiedsplit

@@ -4,20 +4,14 @@ on:

4 push:

5jobs:

6 build:

7− runs-on: ${{ matrix.os }}

8− strategy:

9− matrix:

10− ghc: ['ghc884', 'ghc8101']

11− os: [ubuntu-latest]

7+ runs-on: ubuntu-latest

12− name: GHC ${{ matrix.ghc }}

13 steps:

8 steps:

14 - uses: actions/checkout@v2

9 - uses: actions/checkout@v2

15− - uses: cachix/install-nix-action@v10

10+ - uses: nixbuild/nix-quick-install-action@v21

16− - uses: cachix/cachix-action@v6

17 with:

11 with:

18− name: juspay-nau

12+ nix_conf: |

19− signingKey: '${{ secrets.CACHIX_SIGNING_KEY }}'

13+ experimental-features = nix-command flakes

20− # Only needed for private caches

21− authToken: '${{ secrets.CACHIX_AUTH_TOKEN }}'

22 - name: Build and test 🔧

14 - name: Build and test 🔧

23− run: nix-build -j4 --argstr compiler ${{ matrix.ghc }}

15+ run: nix build -j 4 -L

16+ - name: Build and test (GHC 8.8) 🔧

17+ run: nix build -j 4 -L .#jrec-ghc88

.vscode/extensions.jsonnew file+11

@@ -0,0 +1,11 @@

1+{

2+ // See https://go.microsoft.com/fwlink/?LinkId=827846

3+ // for the documentation about the extensions.json format

4+ "recommendations": [

5+ "haskell.haskell",

6+ "arrterian.nix-env-selector",

7+ "bbenoist.nix",

8+ "jnoortheen.nix-ide",

9+ "tamasfe.even-better-toml"

10+ ]

11+}

.vscode/settings.json+5−4

@@ -1,5 +1,6 @@

1{

2+ "editor.formatOnType": true,

3+ "editor.formatOnSave": true,

2− "nixEnvSelector.nixShellConfig": "${workspaceRoot}/default.nix",

4+ "nixEnvSelector.nixFile": "${workspaceRoot}/shell.nix",

3− "editor.formatOnType": true,

5+ "haskell.manageHLS": "PATH"

4− "editor.formatOnSave": true

5−}

6+}

CHANGELOG.md+4

@@ -1,5 +1,9 @@

1# Revision history for rec

2

3+## Unreleased

4+

5+- GHC 9.2 + Aeson 2.0 support

6+

3## 0.1.0.0 -- YYYY-mm-dd

7## 0.1.0.0 -- YYYY-mm-dd

4

8

5* First version. Released on an unsuspecting world.

9* First version. Released on an unsuspecting world.

Setup.hsdeleted−2

@@ -1,2 +0,0 @@

1−import Distribution.Simple

2−main = defaultMain

bin/test+1−1

@@ -2,4 +2,4 @@

2set -xe

3

4# NOTE: ghcid should be run with -W to allow warnings from should-not-typecheck

5−nix-shell --pure --run "ghcid $* -W -c 'cabal new-repl test:jrec-test' -T \":main $*\""

5+nix develop -c sh -c "ghcid $* -W -c 'cabal new-repl test:jrec-test' -T \":main $*\""

default.nixdeleted−36

@@ -1,36 +0,0 @@

1−let

2− nixpkgsSrc = builtins.fetchTarball {

3− url = "https://github.com/nixos/nixpkgs/archive/76f2e271a2ef.tar.gz";

4− sha256 = "1r4da3kyghqq7vzya5yb295jpnha1fgp755bi6wda4fmhyaynnsp";

5− };

6− gitignoreSrc = builtins.fetchTarball {

7− url = "https://github.com/hercules-ci/gitignore/archive/c4662e6.tar.gz";

8− sha256 = "1npnx0h6bd0d7ql93ka7azhj40zgjp815fw2r6smg8ch9p7mzdlx";

9− };

10− inherit (import gitignoreSrc { inherit (pkgs); }) gitignoreSource;

11−in {

12− compiler ? "default",

13− pkgs ? import nixpkgsSrc {},

14−}:

15− let

16− haskellPackages =

17− if compiler == "default"

18− then pkgs.haskellPackages

19− else pkgs.haskell.packages.${compiler};

20− projectDrv =

21− haskellPackages.override {

22− overrides = self: super: with pkgs.haskell.lib; {

23− jrec = self.callCabal2nix "jrec" (gitignoreSource ./.) {};

24− # https://github.com/lspitzner/data-tree-print/pull/2

25− data-tree-print = doJailbreak super.data-tree-print;

26− };

27− };

28− projectShell =

29− projectDrv.shellFor {

30− packages = p: [ p.jrec ];

31− buildInputs = with projectDrv; [

32− cabal-install

33− ];

34− };

35− in

36− if pkgs.lib.inNixShell then projectShell else projectDrv.jrec

flake.locknew file+81

@@ -0,0 +1,81 @@

1+{

2+ "nodes": {

3+ "flake-parts": {

4+ "inputs": {

5+ "nixpkgs-lib": "nixpkgs-lib"

6+ },

7+ "locked": {

8+ "lastModified": 1678379998,

9+ "narHash": "sha256-TZdfNqftHhDuIFwBcN9MUThx5sQXCTeZk9je5byPKRw=",

10+ "owner": "hercules-ci",

11+ "repo": "flake-parts",

12+ "rev": "c13d60b89adea3dc20704c045ec4d50dd964d447",

13+ "type": "github"

14+ },

15+ "original": {

16+ "owner": "hercules-ci",

17+ "repo": "flake-parts",

18+ "type": "github"

19+ }

20+ },

21+ "nixpkgs": {

22+ "locked": {

23+ "lastModified": 1678594102,

24+ "narHash": "sha256-OHAHYiMWJFPNxuW/PcOMlSD2tvXnEYC1jxREBADHwwQ=",

25+ "owner": "nixos",

26+ "repo": "nixpkgs",

27+ "rev": "796b4a3c1d903c4b9270cd2548fe46f524eeb886",

28+ "type": "github"

29+ },

30+ "original": {

31+ "owner": "nixos",

32+ "ref": "nixpkgs-unstable",

33+ "repo": "nixpkgs",

34+ "type": "github"

35+ }

36+ },

37+ "nixpkgs-ghc88": {

38+ "locked": {

39+ "lastModified": 1596466290,

40+ "narHash": "sha256-V1vrlYfVEdW4iauUc58LCtorSxLLF+X/PhjD5+dQjeQ=",

41+ "owner": "nixos",

42+ "repo": "nixpkgs",

43+ "rev": "76f2e271a2ef9de3734dcc9d366a42d6bfb18e82",

44+ "type": "github"

45+ },

46+ "original": {

47+ "owner": "nixos",

48+ "ref": "76f2e271a2ef",

49+ "repo": "nixpkgs",

50+ "type": "github"

51+ }

52+ },

53+ "nixpkgs-lib": {

54+ "locked": {

55+ "dir": "lib",

56+ "lastModified": 1678375444,

57+ "narHash": "sha256-XIgHfGvjFvZQ8hrkfocanCDxMefc/77rXeHvYdzBMc8=",

58+ "owner": "NixOS",

59+ "repo": "nixpkgs",

60+ "rev": "130fa0baaa2b93ec45523fdcde942f6844ee9f6e",

61+ "type": "github"

62+ },

63+ "original": {

64+ "dir": "lib",

65+ "owner": "NixOS",

66+ "ref": "nixos-unstable",

67+ "repo": "nixpkgs",

68+ "type": "github"

69+ }

70+ },

71+ "root": {

72+ "inputs": {

73+ "flake-parts": "flake-parts",

74+ "nixpkgs": "nixpkgs",

75+ "nixpkgs-ghc88": "nixpkgs-ghc88"

76+ }

77+ }

78+ },

79+ "root": "root",

80+ "version": 7

81+}

flake.nixnew file+34

@@ -0,0 +1,34 @@

1+{

2+ inputs = {

3+ nixpkgs.url = "github:nixos/nixpkgs/nixpkgs-unstable";

4+ nixpkgs-ghc88.url = "github:nixos/nixpkgs/76f2e271a2ef";

5+ flake-parts.url = "github:hercules-ci/flake-parts";

6+ };

7+ outputs = inputs@{ nixpkgs, flake-parts, ... }:

8+ flake-parts.lib.mkFlake { inherit inputs; } {

9+ systems = nixpkgs.lib.systems.flakeExposed;

10+ perSystem = { self', inputs', pkgs, system, ... }:

11+ let

12+ overlay = self: super: {

13+ jrec = self.callCabal2nix "jrec" ./. { };

14+ };

15+ ghcVersions = {

16+ ghc88 = inputs.nixpkgs-ghc88.legacyPackages.${system}.haskellPackages.extend overlay;

17+ ghc92 = pkgs.haskellPackages.extend overlay;

18+ };

19+ in

20+ {

21+ packages.default = ghcVersions.ghc92.jrec;

22+ devShells.default = ghcVersions.ghc92.shellFor {

23+ packages = p: [ p.jrec ];

24+ buildInputs = with ghcVersions.ghc92; [

25+ cabal-install

26+ ghcid

27+ haskell-language-server

28+ ];

29+ };

30+ # Expose jrec built with GHC 8.8 so it can be tested in CI.

31+ packages.jrec-ghc88 = ghcVersions.ghc88.jrec;

32+ };

33+ };

34+}

jrec.cabal+15−3

@@ -1,6 +1,6 @@

1cabal-version: 2.4

2name: jrec

3−version: 0.1.0.0

3+version: 0.1.0.1

4synopsis: anonymous records for busy people

5

6-- description:

@@ -24,13 +24,20 @@ flag with-aeson

24 -- with instances by default

25 default: True

26

27+flag with-generics

28+ description: Enable GHC.Generics instances

29+ -- don't let the solver fiddle with the flag

30+ manual: True

31+ -- with instances by default

32+ default: True

33+

27-- A common stanza to share with tests, so that ghcid (bin/test) will reload

34-- A common stanza to share with tests, so that ghcid (bin/test) will reload

28-- instantly when the library sources change (without us having to restart it).

35-- instantly when the library sources change (without us having to restart it).

29common library-common

36common library-common

30 default-language: Haskell2010

37 default-language: Haskell2010

31 build-depends:

38 build-depends:

32 aeson

39 aeson

33− , base >=4.13 && <4.15

40+ , base >=4.13 && <4.17

34 , constraints

41 , constraints

35 , deepseq

42 , deepseq

36 , generic-data

43 , generic-data

@@ -81,13 +88,18 @@ library

81 JRec.Field

88 JRec.Field

82 if flag(with-aeson)

89 if flag(with-aeson)

83 cpp-options: -DWITH_AESON

90 cpp-options: -DWITH_AESON

91+ if flag(with-generics)

92+ cpp-options: -DWITH_GENERICS

84

93

85test-suite jrec-test

94test-suite jrec-test

86 import: library-common

95 import: library-common

87 type: exitcode-stdio-1.0

96 type: exitcode-stdio-1.0

88 hs-source-dirs: test, src

97 hs-source-dirs: test, src

89 main-is: Spec.hs

98 main-is: Spec.hs

90− cpp-options: -DWITH_AESON

99+ cpp-options: -DWITH_AESON -DWITH_GENERICS

100+ other-modules:

101+ JRecShouldNotTypecheckSpec

102+ JRecSpec

91 build-depends:

103 build-depends:

92 base,

104 base,

93 hspec,

105 hspec,

shell.nixnew file+1

@@ -0,0 +1 @@

1+(builtins.getFlake ("git+file://" + toString ./.)).devShells.${builtins.currentSystem}.default

src/JRec.hs+4−7

@@ -1,3 +1,4 @@

1+{-# LANGUAGE CPP #-}

1{-# LANGUAGE GADTs #-}

2{-# LANGUAGE GADTs #-}

2{-# LANGUAGE PatternSynonyms #-}

3{-# LANGUAGE PatternSynonyms #-}

3{-# LANGUAGE TypeApplications #-}

4{-# LANGUAGE TypeApplications #-}

@@ -49,13 +50,7 @@ unField _ (_ R.:= value) = value

49-- FIXME: See spec for a bug when there are duplicates.

50-- FIXME: See spec for a bug when there are duplicates.

50append ::

51append ::

51 forall lhs rhs res.

52 forall lhs rhs res.

52− ( KnownNat (R.RecSize lhs),

53− KnownNat (R.RecSize rhs),

54− KnownNat (R.RecSize lhs + R.RecSize rhs),

55− res ~ R.RecAppend lhs rhs,

53+ res ~ R.RecAppend lhs rhs =>

56− R.RecCopy lhs lhs res,

57− R.RecCopy rhs rhs res

58− ) =>

59 Rec lhs ->

54 Rec lhs ->

60 Rec rhs ->

55 Rec rhs ->

61 Rec res

56 Rec res

@@ -134,6 +129,7 @@ type RecordRep fields =

134 (Sels fields)

129 (Sels fields)

135 )

130 )

136

131

132+#ifdef WITH_GENERICS

137instance

133instance

138 (R.FromNative (RecordRep fields) fields, R.ToNative (RecordRep fields) fields) =>

134 (R.FromNative (RecordRep fields) fields, R.ToNative (RecordRep fields) fields) =>

139 Generic (Rec fields)

135 Generic (Rec fields)

@@ -143,6 +139,7 @@ instance

143 RecordRep fields

139 RecordRep fields

144 from r = R.toNative' r

140 from r = R.toNative' r

145 to rep = R.fromNative' rep

141 to rep = R.fromNative' rep

142+#endif

146

143

147----------------------------------------------------------------------------

144----------------------------------------------------------------------------

148-- generic-lens

145-- generic-lens

src/JRec/Internal.hs+25−31

@@ -32,6 +32,7 @@ import qualified Control.Monad.State as S

32import Data.Aeson

33import Data.Aeson.Types (Parser)

34import Data.Constraint

35+import Data.List (intercalate)

35import Data.Maybe (catMaybes)

36import Data.Maybe (catMaybes)

36import Data.Proxy

37import Data.Proxy

37import qualified Data.Text as T

38import qualified Data.Text as T

@@ -42,11 +43,17 @@ import GHC.OverloadedLabels

42import GHC.Prim

43import GHC.Prim

43import GHC.ST (ST (..), runST)

44import GHC.ST (ST (..), runST)

44import GHC.TypeLits

45import GHC.TypeLits

45−import Generic.Data (gshowsPrec)

46−import Generic.Data.Internal.Show (GShow)

47import qualified Optics.Lens as OL

46import qualified Optics.Lens as OL

48import Unsafe.Coerce

47import Unsafe.Coerce

49import Prelude

48import Prelude

49+#if MIN_VERSION_aeson(2,0,0)

50+import Data.Aeson.Key (fromText, fromString)

51+#else

52+fromText :: a -> a

53+fromText = id

54+fromString :: String -> T.Text

55+fromString = T.pack

56+#endif

50

57

51-- | Field named @l@ labels value of type @t@ adapted from the awesome /labels/ package.

58-- | Field named @l@ labels value of type @t@ adapted from the awesome /labels/ package.

52-- Example: @(#name := \"Chris\") :: (\"name\" := String)@

59-- Example: @(#name := \"Chris\") :: (\"name\" := String)@

@@ -102,13 +109,12 @@ defaultJSONOptions = JSONOptions {fieldTransform = id}

102type role Rec representational

109type role Rec representational

103

110

104instance

111instance

105− ( RecApply lts lts Show,

112+ ( RecApply lts lts Show

106− GShow Proxy (Rep (Rec lts)),

107− Generic (Rec lts)

108 ) =>

113 ) =>

109 Show (Rec lts)

114 Show (Rec lts)

110 where

115 where

111− show = (\x -> if null x then "{}" else x) . unwords . drop 1 . words . flip (gshowsPrec 0) ""

116+ show rec = "{" ++ formatted ++ "}"

117+ where formatted = intercalate ", " $ map (\(k, v) -> k ++ " = " ++ v) $ showRec rec

112

118

113instance RecEq lts lts => Eq (Rec lts) where

119instance RecEq lts lts => Eq (Rec lts) where

114 (==) (a :: Rec lts) (b :: Rec lts) = recEq a b (Proxy :: Proxy lts)

120 (==) (a :: Rec lts) (b :: Rec lts) = recEq a b (Proxy :: Proxy lts)

@@ -403,26 +409,20 @@ type family RecDeepTy (ps :: r) (lts :: [*]) :: * where

403-- NOTE: changed from original superrecord to not require a 'Sort'

409-- NOTE: changed from original superrecord to not require a 'Sort'

404combine ::

410combine ::

405 forall lhs rhs res.

411 forall lhs rhs res.

406− ( KnownNat (RecSize lhs),

407− KnownNat (RecSize rhs),

408− KnownNat (RecSize lhs + RecSize rhs),

409− res ~ RecAppend lhs rhs,

412+ res ~ RecAppend lhs rhs =>

410− RecCopy lhs lhs res,

411− RecCopy rhs rhs res

412− ) =>

413 Rec lhs ->

414 Rec rhs ->

415 Rec res

416−combine lts rts =

416+combine (MkRec arr0#) (MkRec arr1#) =

417− let !(I# size#) =

417+ let !size0# = sizeofSmallArray# arr0#

418− fromIntegral $ natVal' (proxy# :: Proxy# (RecSize lhs + RecSize rhs))

418+ !size1# = sizeofSmallArray# arr1#

419 in runST' $

420 ST $ \s# ->

421− case newSmallArray# size# (error "No value") s# of

421+ case newSmallArray# (size0# +# size1#) (error "No value") s# of

422 (# s'#, arr# #) ->

423− case recCopyInto (Proxy :: Proxy lhs) lts (Proxy :: Proxy res) arr# s'# of

423+ case copySmallArray# arr1# 0# arr# 0# size1# s'# of

424 s''# ->

425− case recCopyInto (Proxy :: Proxy rhs) rts (Proxy :: Proxy res) arr# s''# of

425+ case copySmallArray# arr0# 0# arr# size1# size0# s''# of

426 s'''# ->

427 case unsafeFreezeSmallArray# arr# s'''# of

428 (# s''''#, a# #) -> (# s''''#, MkRec a# #)

@@ -492,13 +492,7 @@ insert (l := v) rts =

492-- | Alias for 'combine'

493(++:) ::

494 forall lhs rhs res.

495− ( KnownNat (RecSize lhs),

496− KnownNat (RecSize rhs),

497− KnownNat (RecSize lhs + RecSize rhs),

498− res ~ RecAppend lhs rhs,

495+ res ~ RecAppend lhs rhs =>

499− RecCopy lhs lhs res,

500− RecCopy rhs rhs res

501− ) =>

502 Rec lhs ->

496 Rec lhs ->

503 Rec rhs ->

497 Rec rhs ->

504 Rec res

498 Rec res

@@ -572,16 +566,16 @@ class ToJSON a => EncodeField a where

572

566

573instance ToJSON a => EncodeField a where

567instance ToJSON a => EncodeField a where

574 encodeField = pure . toJSON

568 encodeField = pure . toJSON

575− encodeKV = (.=)

569+ encodeKV k v = fromText k .= v

576

570

577instance {-# OVERLAPS #-} ToJSON a => EncodeField (Maybe a) where

571instance {-# OVERLAPS #-} ToJSON a => EncodeField (Maybe a) where

578 encodeField = fmap toJSON

572 encodeField = fmap toJSON

579 encodeKV _ Nothing = mempty

573 encodeKV _ Nothing = mempty

580− encodeKV k v = k .= v

574+ encodeKV k v = fromText k .= v

581

575

582recToValue :: forall lts. (RecApply lts lts EncodeField) => JSONOptions -> Rec lts -> Value

576recToValue :: forall lts. (RecApply lts lts EncodeField) => JSONOptions -> Rec lts -> Value

583recToValue options r =

577recToValue options r =

584− object $ catMaybes $ reflectRec @EncodeField Proxy (\k v -> (T.pack (fieldTransform options k),) <$> encodeField v) r

578+ object $ catMaybes $ reflectRec @EncodeField Proxy (\k v -> (fromString (fieldTransform options k),) <$> encodeField v) r

585

579

586recToEncoding :: forall lts. (RecApply lts lts EncodeField) => JSONOptions -> Rec lts -> Encoding

580recToEncoding :: forall lts. (RecApply lts lts EncodeField) => JSONOptions -> Rec lts -> Encoding

587recToEncoding options r =

581recToEncoding options r =

@@ -686,10 +680,10 @@ class FromJSON a => ParseField a where

686 parseField :: Object -> T.Text -> Parser a

680 parseField :: Object -> T.Text -> Parser a

687

681

688instance FromJSON a => ParseField a where

682instance FromJSON a => ParseField a where

689− parseField = (.:)

683+ parseField o k = o .: fromText k

690

684

691instance {-# OVERLAPS #-} FromJSON a => ParseField (Maybe a) where

685instance {-# OVERLAPS #-} FromJSON a => ParseField (Maybe a) where

692− parseField = (.:?)

686+ parseField o k = o .:? fromText k

693

687

694instance

688instance

695 ( KnownSymbol l,

689 ( KnownSymbol l,

test/JRecSpec.hs+10−4

@@ -71,11 +71,17 @@ spec = do

71 it "simple append" $ do

72 Rec (#a := 1) `append` Rec (#b := 2)

73 `shouldBe` Rec (#a := 1, #b := 2)

74+ Rec () `append` Rec (#b := 2)

75+ `shouldBe` Rec (#b := 2)

76+ Rec (#a := 1) `append` Rec ()

77+ `shouldBe` Rec (#a := 1)

78+ Rec (#a := 1, #b := 2) `append` Rec (#c := 3)

79+ `shouldBe` Rec (#a := 1, #b := 2, #c := 3)

80+ Rec (#a := 1) `append` Rec (#b := 2, #c := 3)

81+ `shouldBe` Rec (#a := 1, #b := 2, #c := 3)

82+ Rec (#a := 1, #b := 2) `append` Rec (#c := 3, #d := 4)

83+ `shouldBe` Rec (#a := 1, #b := 2, #c := 3, #d := 4)

74 it "append with duplicates" $ do

84 it "append with duplicates" $ do

75− -- TODO: `append` will not deal with duplicates; based on current

76− -- implementation, the last value (here, 8) will overwrite all duplicate

77− -- fields. See `union` if you want to deal with duplicates sensibly.

78− pendingWith "append should just append?"

79 let r1 = Rec (#b := 5, #a := 6)

85 let r1 = Rec (#b := 5, #a := 6)

80 r2 = Rec (#c := 7, #a := 8)

86 r2 = Rec (#c := 7, #a := 8)

81 r1 `append` r2

87 r1 `append` r2