From 5849c96fa6a058a8e3d79a17e0de845ab4d03fc8 Mon Sep 17 00:00:00 2001 From: Patrick Spek Date: Thu, 12 Nov 2020 20:36:08 +0100 Subject: Rewrite module --- .gitlab-ci.yml | 55 ++++++++++++++++++++++++ CHANGELOG.md | 16 +++++++ META6.json | 5 +-- lib/Hash/Merge.pm6 | 102 ++++++++++++++++++++++++++------------------- lib/Hash/Merge/Augment.pm6 | 73 ++++++++++---------------------- t/01-thing.t | 4 +- t/02-empty-source.t | 26 +++++------- 7 files changed, 166 insertions(+), 115 deletions(-) create mode 100644 .gitlab-ci.yml diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml new file mode 100644 index 0000000..636a4d1 --- /dev/null +++ b/.gitlab-ci.yml @@ -0,0 +1,55 @@ +stages: + - Test + - Release + +# +# Tests +# + +Prove: + stage: Test + except: + - master + image: registry.gitlab.com/tyil/docker-perl6:debian-dev-latest + variables: + ASSIXT_TESTING_SILENT: "1" + cache: + key: ${CI_COMMIT_REF_NAME} + paths: + - /usr/local/share/perl6/site + before_script: + - apt update + - apt install -y build-essential + - zef install App::Prove6 + - zef install --deps-only --test-depends --/test . + script: prove6 -l + +RakuDist: + stage: Test + image: alpine + before_script: + - apk add --no-cache curl + script: + - curl -d thing="$CI_PROJECT_URL" -d sha="$CI_COMMIT_SHA" https://rakudist.raku.org/queue + +# +# Release targets +# + +Distribution: + stage: Release + only: + refs: + - tags + - master + image: rakudo-star + script: + - echo "NOOP" + artifacts: + name: App-CPAN-${CI_COMMIT_TAG} + paths: + - META6.json + - lib + - bin + - t + - resources diff --git a/CHANGELOG.md b/CHANGELOG.md index a9bcec5..dd11733 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,6 +5,22 @@ The format is based on [Keep a Changelog](http://keepachangelog.com/en/1.0.0/) and this project adheres to [Semantic Versioning](http://semver.org/spec/v2.0.0.html). +## [Unreleased] + +### Added + +- A `gitlab-ci.yaml` has been added to ensure tests for this module are being + ran when pushed to the GitLab mirror. It runs `prove6`, as well as queueing a + build on rakudist.raku.org. + +### Changed + +- `Hash::Merge` has been rewritten to accomodate my current knowledge on the + Raku programming language. This additionaly brings in a small change in the + merging functionality, making it so the first argument passed to `merge-hash` + is no longer modified itself, which could cause some awkward bugs in other + programs. + ## [1.0.0] - 2018-03-28 ### Added - `:api` key in `META6.json` diff --git a/META6.json b/META6.json index aff3030..4fef3d0 100644 --- a/META6.json +++ b/META6.json @@ -6,9 +6,8 @@ "Patrick Spek " ], "depends": [ - ], - "description": "Module to add deep merge functionality to Hashes", + "description": "Raku module to deep merge Hashes", "license": "Artistic-2.0", "name": "Hash::Merge", "perl": "6.c", @@ -25,4 +24,4 @@ "Test::META" ], "version": "1.0.0" -} \ No newline at end of file +} diff --git a/lib/Hash/Merge.pm6 b/lib/Hash/Merge.pm6 index 607e17b..7bc5bab 100644 --- a/lib/Hash/Merge.pm6 +++ b/lib/Hash/Merge.pm6 @@ -1,60 +1,76 @@ #! /usr/bin/env false -use v6.c; +use v6.d; unit module Hash::Merge; #| Merge any number of Hashes together. -sub merge-hashes( - *@hashes, #= Hashes to merge together - --> Hash +sub merge-hashes ( + *@hashes, #= Hashes to merge together + --> Hash ) is export { - my %merge-into = @hashes.shift; + my %merge-into = @hashes.shift; - # Nothing to do if we only got 1 argument - return %merge-into unless @hashes.elems; + # Nothing to do if we only got 1 argument + return %merge-into unless @hashes.elems; - for ^@hashes.elems { - %merge-into = merge-hash(%merge-into, @hashes.shift); - } + for ^@hashes.elems { + %merge-into = merge-hash(%merge-into, @hashes.shift); + } - %merge-into; + %merge-into; } #| Merge two hashes together. -sub merge-hash( - %merge-into, #= The original Hash that should be merged into. - %merge-source, #= Another Hash to merge into the original Hash. - Bool:D :$no-append-array = False, - --> Hash +sub merge-hash ( + #| The original Hash to merge the second Hash into. + %first, + + #| The second hash, which will be merged into the first Hash. + %second, + + #| Boolean to set whether Associative objects should be merged on their + #| own. When set to False, Associative objects in %second will + #| overwrite those from %first. + Bool:D :$deep = True, + + #| Boolean to set whether Positional objects should be appended. When + #| set to False, Positional objects in %second will overwrite those + #| from %first. + Bool:D :$positional-append = True, + + --> Hash ) is export { - for %merge-source.keys -> $key { - if %merge-into{$key}:exists { - given %merge-source{$key} { - when Hash { - merge-hash(%merge-into{$key}, %merge-source{$key}, :$no-append-array); - } - when Positional { - %merge-into{$key} = $no-append-array - ?? %merge-source{$key} - !! - do { - my @a; - @a.push: $_ for %merge-into{$key}.list; - @a.push: $_ for %merge-source{$key}.list; - @a; - } - } - default { - %merge-into{$key} = %merge-source{$key} - } - } - } else { - %merge-into{$key} = %merge-source{$key}; - } - } - - %merge-into; + my %result = %first; + + for %second.keys -> $key { + # If the key doesn't exist yet in %first, it can be inserted without worry. + if (%first{$key}:!exists) { + %result{$key} = %second{$key}; + next; + } + + given (%first{$key}) { + # Associative objects need to be merged deeply. + when Associative { + %result{$key} = $deep + ?? merge-hash(%first{$key}, %second{$key}, :$deep, :$positional-append) + !! %second{$key} + } + # Positional objects can be merged or overwritten depending on $append-array. + when Positional { + %result{$key} = $positional-append + ?? (|%first{$key}, |%second{$key}) + !! %second{$key} + } + # Anything else will just overwrite. + default { + %result{$key} = %second{$key}; + } + } + } + + %result; } # vim: ft=perl6 ts=4 sw=4 et diff --git a/lib/Hash/Merge/Augment.pm6 b/lib/Hash/Merge/Augment.pm6 index b256b8e..3a8cde6 100644 --- a/lib/Hash/Merge/Augment.pm6 +++ b/lib/Hash/Merge/Augment.pm6 @@ -3,61 +3,32 @@ use v6.c; use MONKEY-TYPING; +use Hash::Merge; +use X::Hash::Merge::TypeObject; + # Don't use precompilation in order to not conflict with other MONKEY-TYPING # modules. no precompilation; -augment class Hash -{ - #| Merges a second hash into the hash the method is called on. Hash given as - #| the argument is not modified. - #| Traverses the full tree, replacing items in the original hash with the - #| hash given in the argument. Does not replace positional elements by default, - #| and instead appends the items from the supplied hash's array to the original - #| hash's array. The object type of positionals is not retained and instead - #| becomes an Array type. - #| Use :no-append-array to replace arrays and positionals instead, which will - #| also retain the original type and not convert to an Array - multi method merge (Hash:U: %b, Bool:D :$no-append-array = False) { - warn "Cannot merge an undefined Hash!"; - return %b; - } - - multi method merge (Hash:D: %b, Bool:D :$no-append-array = False) - { - hashmerge self, %b, :$no-append-array; - } - - sub hashmerge (%merge-into, %merge-source, Bool:D :$no-append-array) - { - for %merge-source.keys -> $key { - if %merge-into{$key}:exists { - given %merge-source{$key} { - when Hash { - hashmerge %merge-into{$key}, - %merge-source{$key}, - :$no-append-array; - } - when Positional { - %merge-into{$key} = $no-append-array - ?? %merge-source{$key} - !! - do { - my @a; - @a.push: $_ for %merge-into{$key}.list; - @a.push: $_ for %merge-source{$key}.list; - @a; - } - } - # Non-positionals, so strings or Bools or whatever - default { %merge-into{$key} = %merge-source{$key} } - } - } else { - %merge-into{$key} = %merge-source{$key}; - } - } - %merge-into; - } +augment class Hash { + method merge ( + Hash:D: + + #| The Hash to merge into this one. + %hash, + + #| Boolean to set whether Associative objects should be merged on their + #| own. When set to False, Associative objects in %second will + #| overwrite those from %first. + Bool:D :$deep = True, + + #| Boolean to set whether Positional objects should be appended. When + #| set to False, Positional objects in %second will overwrite those + #| from %first. + Bool:D :$positional-append = True, + ) { + self = merge-hash(self, %hash, :$deep, :$positional-append); + } } # vim: ft=perl6 ts=4 sw=4 et diff --git a/t/01-thing.t b/t/01-thing.t index ef674ec..44d7495 100644 --- a/t/01-thing.t +++ b/t/01-thing.t @@ -46,9 +46,9 @@ is-deeply %a, {Z => 'new', a => 2, b => 1, y => {a => 1, z => 2}}; %z

= (1,2,3,4); %y

= (5,4,6,7); - %z.merge(%y, :no-append-array); + %z.merge(%y, :!positional-append); - is-deeply %z, ${:y(${:p($(5, 4, 6, 7))})}, "no-append-array (replaces the instead)"; + is-deeply %z, ${:y(${:p($(5, 4, 6, 7))})}, ":!positional-append makes lists overwrite"; } done-testing; diff --git a/t/02-empty-source.t b/t/02-empty-source.t index 2737d2d..55403e1 100644 --- a/t/02-empty-source.t +++ b/t/02-empty-source.t @@ -1,28 +1,22 @@ #! /usr/bin/env perl6 -use v6.c; -use lib 'lib'; -use Test; +use v6.d; -plan 3; +use Test; use Hash::Merge::Augment; -my Hash $hash = { +plan 1; + +my %hash = a => "a", b => { c => "c" - } -}; - -my Hash $empty = {}; - -$empty.merge($hash); - -is-deeply $empty, $hash, "Merge into empty hash"; + }, +; -my Hash $nil; +my %empty; +%empty.merge(%hash); -throws-like $nil.merge($hash), Exception, "Merge into uninitialized hash"; -is-deeply $nil.merge($hash), $hash, "Returns supplied hash if it throws"; +is-deeply %empty, %hash, "Merge into empty hash"; -- cgit v1.1