aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorPatrick Spek <p.spek@tyil.nl>2020-11-12 20:36:08 +0100
committerPatrick Spek <p.spek@tyil.nl>2020-11-12 20:36:08 +0100
commit5849c96fa6a058a8e3d79a17e0de845ab4d03fc8 (patch)
tree0538fa597f84e28335f6d7ddf2ba03f9edf0a7c9
parent95e89dee79200e1ea75b1ef976a30bf6b61e23a7 (diff)
Rewrite module
-rw-r--r--.gitlab-ci.yml55
-rw-r--r--CHANGELOG.md16
-rw-r--r--META6.json5
-rw-r--r--lib/Hash/Merge.pm6102
-rw-r--r--lib/Hash/Merge/Augment.pm673
-rw-r--r--t/01-thing.t4
-rw-r--r--t/02-empty-source.t26
7 files changed, 166 insertions, 115 deletions
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 <p.spek@tyil.work>"
],
"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<y><p> = (1,2,3,4);
%y<y><p> = (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";