Initial commit

13 files changed, 603 insertions, 0 deletions

diff --git a/.editorconfig b/.editorconfig
new file mode 100644
index 0000000..74dde7f
--- /dev/null
+++ b/.editorconfig
@@ -0,0 +1,16 @@
+[*]
+charset              = utf-8
+end_of_line          = lf
+insert_final_newline = true
+indent_style         = tab
+indent_size          = 4
+
+[*.json]
+indent_style = space
+indent_size  = 2
+
+[*.yml]
+indent_style = space
+indent_size  = 2
+
+# vim: ft=dosini
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..93356c2
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,14 @@
+## Perl 6 precompilation files ##
+.precomp
+
+## Editor files ##
+
+# emacs
+*~
+
+# vim
+.*.sw?
+
+# comma
+.idea
+*.iml
diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml
new file mode 100644
index 0000000..361902e
--- /dev/null
+++ b/.gitlab-ci.yml
@@ -0,0 +1,23 @@
+URL:
+  only:
+    - master
+  image: rakudo-star
+  before_script:
+    - zef install . --deps-only --test-depends --/test
+  script: AUTHOR_TESTING=1 prove -v -e "perl6 -Ilib" t
+  artifacts:
+    name: "perl6-URL"
+    paths:
+      - META6.json
+      - bin
+      - lib
+      - resources
+      - t
+
+test:
+  except:
+    - master
+  image: rakudo-star
+  before_script:
+    - zef install . --deps-only --test-depends --/test
+  script: AUTHOR_TESTING=1 prove -v -e "perl6 -Ilib" t
diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
index 0000000..c073e0e
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,9 @@
+# Changelog
+All notable changes to this project will be documented in this file.
+
+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).
+
+## [0.1.0] - 2019-04-08
+- Initial release
diff --git a/META6.json b/META6.json
new file mode 100644
index 0000000..f938a5a
--- /dev/null
+++ b/META6.json
@@ -0,0 +1,27 @@
+{
+  "api": "0",
+  "authors": [
+    "Patrick Spek <p.spek@tyil.work>"
+  ],
+  "depends": [
+    
+  ],
+  "description": "A Perl 6 library to handle URLs",
+  "license": "AGPL-3.0",
+  "meta-version": 0,
+  "name": "URL",
+  "perl": "6.d",
+  "provides": {
+    "URL": "lib/URL.pm6",
+    "URL::Grammar": "lib/URL/Grammar.pm6",
+    "URL::Grammar::Actions": "lib/URL/Grammar/Actions.pm6"
+  },
+  "resources": [
+    
+  ],
+  "source-url": "https://git.tyil.nl/perl6/url",
+  "tags": [
+    
+  ],
+  "version": "0.1.0"
+}
\ No newline at end of file
diff --git a/README.pod6 b/README.pod6
new file mode 100644
index 0000000..625b63b
--- /dev/null
+++ b/README.pod6
@@ -0,0 +1,23 @@
+=begin pod
+
+=NAME    URL
+=AUTHOR  Patrick Spek <p.spek@tyil.work>
+=VERSION 0.0.0
+
+=head1 Description
+
+A Perl 6 library to handle URLs
+
+=head1 Installation
+
+Install this module through L<zef|https://github.com/ugexe/zef>:
+
+=begin code :lang<sh>
+zef install URL
+=end code
+
+=head1 License
+
+This module is distributed under the terms of the AGPL-3.0.
+
+=end pod
diff --git a/lib/URL.pm6 b/lib/URL.pm6
new file mode 100644
index 0000000..57235b4
--- /dev/null
+++ b/lib/URL.pm6
@@ -0,0 +1,126 @@
+#! /usr/bin/env false
+
+use v6.d;
+
+use URL::Grammar;
+use URL::Grammar::Actions;
+
+unit class URL;
+
+has Str $.scheme;
+has Str $.username;
+has Str $.password;
+has Str $.hostname;
+has Int $.port;
+has @.path;
+has %.query;
+has Str $.fragment;
+
+multi method new (
+	Str:D $url,
+) {
+	my %match = URL::Grammar.parse($url, actions => URL::Grammar::Actions).made;
+
+	die "'$url' failed to parse. Please report the URL you tried to p.spek+perl6@tyil.work." unless %match;
+
+	samewith(
+		|%match,
+		path => %match<path>.list
+	);
+}
+
+multi method new (
+	Str :$scheme,
+	Str :$username,
+	Str :$password,
+	Str :$hostname,
+	Int :$port,
+	:@path = [],
+	:%query = {},
+	Str :$fragment,
+) {
+	self.bless(
+		:$scheme,
+		:$username,
+		:$password,
+		:$hostname,
+		:$port,
+		:@path,
+		:%query,
+		:$fragment,
+	);
+}
+
+method Hash (
+	--> Hash
+) {
+	{
+		:$!scheme,
+		:$!username,
+		:$!password,
+		:$!hostname,
+		:$!port,
+		:@!path,
+		:%!query,
+		:$!fragment,
+	}
+}
+
+multi method Str (
+	--> Str
+) {
+	my $s = $!scheme ~ "://";
+
+	$s ~= "{self.Str(:userinfo)}@" if $!username;
+	$s ~= $!hostname;
+	$s ~= ":$!port" if $!port;
+	$s ~= "/{self.Str(:path)}" if @!path;
+	$s ~= "?{self.Str(:query)}" if %!query;
+	$s ~= "#$!fragment" if $!fragment;
+
+	$s;
+}
+
+multi method Str (
+	:$path! where { $_ },
+
+	--> Str
+) {
+	@!path.join("/");
+}
+
+multi method Str (
+	:$query! where { $_ },
+
+	--> Str
+) {
+	%!query.keys.sort.map({ "$_={%!query{$_}}" }).join("&")
+}
+
+multi method Str (
+	:$userinfo! where { $_ },
+
+	--> Str
+) {
+	return "$!username:$!password" if $!password;
+
+	$!username // "";
+}
+
+=begin pod
+
+=NAME    URL
+=AUTHOR  Patrick Spek <p.spek@tyil.work>
+=VERSION 0.1.0
+
+=head1 Synopsis
+
+=head1 Description
+
+=head1 Examples
+
+=head1 See also
+
+=end pod
+
+# vim: ft=perl6 noet
diff --git a/lib/URL/Grammar.pm6 b/lib/URL/Grammar.pm6
new file mode 100644
index 0000000..cc9f13c
--- /dev/null
+++ b/lib/URL/Grammar.pm6
@@ -0,0 +1,48 @@
+#! /usr/bin/env false
+
+use v6.d;
+
+unit grammar URL::Grammar;
+
+token TOP {
+	[ <scheme> ":" ]?
+	"//"?
+	[ <userinfo> "@" ]?
+	<host>?
+	<path>?
+	[ "?" <query> ]?
+	[ "#" <fragment> ]?
+}
+
+token scheme { <[ a..z ]> <[ a..z 0..9 . + - ]>* }
+token userinfo { <username> [ ":" <password> ] }
+token username { <-[ : @ ]>+ }
+token password { <-[ @ ]>+ }
+token host { <hostname> [ ":" <port> ]? }
+token hostname { [ <-[ / : # ? \h ]>+ | "[" <-[ \] ]>+ "]" ] }
+token port { \d ** 1..5 }
+token path { "/" <part=.path-part>* % "/" }
+token path-part { <-[ / ? # ]>+ }
+token query { <part=.query-part>* % "&" }
+token query-part { <key=.query-part-key> "=" <value=.query-part-value> }
+token query-part-key { <-[ = # & ]>+ }
+token query-part-value { <-[ # & ]>+ }
+token fragment { <-[ \s ]>+ }
+
+=begin pod
+
+=NAME    URL::Grammar
+=AUTHOR  Patrick Spek <p.spek@tyil.work>
+=VERSION 0.1.0
+
+=head1 Synopsis
+
+=head1 Description
+
+=head1 Examples
+
+=head1 See also
+
+=end pod
+
+# vim: ft=perl6 noet
diff --git a/lib/URL/Grammar/Actions.pm6 b/lib/URL/Grammar/Actions.pm6
new file mode 100644
index 0000000..2015073
--- /dev/null
+++ b/lib/URL/Grammar/Actions.pm6
@@ -0,0 +1,47 @@
+#! /usr/bin/env false
+
+use v6.d;
+
+unit class URL::Grammar::Actions;
+
+method TOP ($/)
+{
+	make {
+		scheme => $/<scheme>.made // Str,
+		username => $/<userinfo><username>.made // Str,
+		password => $/<userinfo><password>.made // Str,
+		hostname => $/<host><hostname>.made // Str,
+		port => $/<host><port>.made // Int,
+		path => $/<path>.made // [],
+		query => $/<query>.made // {},
+		fragment => $/<fragment>.made // Str,
+	}
+}
+
+method scheme ($/) { make ~$/ }
+method username ($/) { make ~$/ }
+method password ($/) { make ~$/ }
+method hostname ($/) { make ~$/ }
+method port ($/) { make +$/ }
+method path ($/) { make $/<part>».Str }
+method query ($/) { make $/<part>».made }
+method query-part ($/) { make $/<key>.Str => $/<value>.Str }
+method fragment ($/) { make ~$/ }
+
+=begin pod
+
+=NAME    URL::Grammar::Actions
+=AUTHOR  Patrick Spek <p.spek@tyil.work>
+=VERSION 0.1.0
+
+=head1 Synopsis
+
+=head1 Description
+
+=head1 Examples
+
+=head1 See also
+
+=end pod
+
+# vim: ft=perl6 noet
diff --git a/t/01-grammar.t b/t/01-grammar.t
new file mode 100644
index 0000000..a84bf86
--- /dev/null
+++ b/t/01-grammar.t
@@ -0,0 +1,61 @@
+#! /usr/bin/env perl6
+
+use v6.d;
+
+use URL::Grammar;
+use Test;
+
+plan 2;
+
+subtest "https://www.tyil.nl", {
+	plan 8;
+
+	my $match = URL::Grammar.parse("https://www.tyil.nl");
+
+	is ~$match<scheme>, "https", "Scheme is 'https'";
+	nok $match<userinfo><username>, "URL contains no username";
+	nok $match<userinfo><password>, "URL contains no password";
+	is ~$match<host><hostname>, "www.tyil.nl", "Hostname is 'www.tyil.nl'";
+	nok $match<host><port>, "URL contains no port";
+	nok $match<path>, "URL contains no path";
+	nok $match<query>, "URL contains no query";
+	nok $match<fragment>, "URL contains no fragment";
+};
+
+subtest "https://tyil:donthackme\@www.tyil.nl:8443/a/path/part?foo=bar&perl=6#module", {
+	plan 8;
+
+	my $match = URL::Grammar.parse("https://tyil:donthackme\@www.tyil.nl:8443/a/path/part?foo=bar&perl=6#module");
+
+	is ~$match<scheme>, "https", "Scheme is 'https'";
+	is ~$match<userinfo><username>, "tyil", "Username is 'tyil'";
+	is ~$match<userinfo><password>, "donthackme", "Password is 'donthackme'";
+	is ~$match<host><hostname>, "www.tyil.nl", "Hostname is 'www.tyil.nl'";
+	is +$match<host><port>, 8443, "Port is 8443";
+	is ~$match<fragment>, "module", "Fragment is 'module'";
+
+	subtest "path", {
+		plan 4;
+
+		my @path = $match<path><part>;
+
+		is @path.elems, 3, "Path consists of 3 parts";
+		is @path[0], "a", "Part 0 is 'a'";
+		is @path[1], "path", "Part 1 is 'path'";
+		is @path[2], "part", "Part 2 is 'part'";
+	}
+
+	subtest "query", {
+		plan 5;
+
+		my @query = $match<query><part>;
+
+		is @query.elems, 2, "Query consists of 2 parts";
+		is @query[0]<key>, "foo", "Part 0's key is 'foo'";
+		is @query[0]<value>, "bar", "Part 0's value is 'bar'";
+		is @query[1]<key>, "perl", "Part 1's key is 'perl'";
+		is @query[1]<value>, "6", "Part 1's value is '6'";
+	}
+}
+
+# vim: ft=perl6 noet
diff --git a/t/02-actions.t.t b/t/02-actions.t.t
new file mode 100644
index 0000000..8eae227
--- /dev/null
+++ b/t/02-actions.t.t
@@ -0,0 +1,77 @@
+#! /usr/bin/env perl6
+
+use v6.d;
+
+use URL::Grammar;
+use URL::Grammar::Actions;
+
+use Test;
+
+plan 2;
+
+subtest "https://www.tyil.nl", {
+	plan 8;
+
+	my %match = URL::Grammar.parse("https://www.tyil.nl", actions => URL::Grammar::Actions.new).made;
+
+	is %match<scheme>, "https", "Scheme is 'https'";
+	is %match<hostname>, "www.tyil.nl", "Hostname is 'www.tyil.nl'";
+
+	nok %match<username>, "URL contains no username";
+	nok %match<password>, "URL contains no password";
+	nok %match<port>, "URL contains no port";
+	nok %match<path>, "URL contains no path";
+	nok %match<query>, "URL contains no query";
+	nok %match<fragment>, "URL contains no fragment";
+};
+
+subtest "https://tyil:donthackme\@www.tyil.nl:8443/a/path/part?foo=bar&perl=6#module", {
+	plan 8;
+
+	my %match = URL::Grammar.parse(
+		"https://tyil:donthackme\@www.tyil.nl:8443/a/path/part?foo=bar&perl=6#module",
+		actions => URL::Grammar::Actions.new,
+	).made;
+
+	is %match<scheme>, "https", "Scheme is 'https'";
+	is %match<username>, "tyil", "Username is 'tyil'";
+	is %match<password>, "donthackme", "Password is 'donthackme'";
+	is %match<hostname>, "www.tyil.nl", "Hostname is 'www.tyil.nl'";
+	is %match<port>, 8443, "Port is 8443";
+	is %match<fragment>, "module", "Fragment is 'module'";
+
+	subtest "path", {
+		plan 4;
+
+		my @path = %match<path>.list;
+
+		is @path.elems, 3, "Path consists of 3 parts";
+		is @path[0], "a", "Part 0 is 'a'";
+		is @path[1], "path", "Part 1 is 'path'";
+		is @path[2], "part", "Part 2 is 'part'";
+	}
+
+	subtest "query", {
+		plan 3;
+
+		my %query = %match<query>.hash;
+
+		is %query.elems, 2, "Query consists of 2 parts";
+
+		subtest "foo", {
+			plan 2;
+
+			ok %query<foo>:exists, "Query has a key 'foo'";
+			is %query<foo>, "bar", "Value for 'foo' is 'bar'";
+		}
+
+		subtest "perl", {
+			plan 2;
+
+			ok %query<perl>:exists, "Query has a key 'perl'";
+			is %query<perl>, "6", "Value for 'perl' is '6'";
+		}
+	}
+}
+
+# vim: ft=perl6 noet
diff --git a/t/03-instantiation.t b/t/03-instantiation.t
new file mode 100644
index 0000000..15b7efa
--- /dev/null
+++ b/t/03-instantiation.t
@@ -0,0 +1,94 @@
+#! /usr/bin/env perl6
+
+use v6.d;
+
+use Test;
+use URL;
+
+plan 2;
+
+subtest "Object oriented", {
+	plan 2;
+
+	subtest "https://www.tyil.nl", {
+		plan 8;
+
+		my $url = URL.new(
+			scheme => "https",
+			hostname => "www.tyil.nl",
+		);
+
+		is $url.username, Str, "Username is empty";
+		is $url.password, Str, "Password is emtpy";
+		is $url.port, Int, "Port is empty";
+		is $url.path, [], "Path is empty";
+		is $url.query, {}, "Query is empty";
+		is $url.fragment, Str, "Fragment is empty";
+
+		is $url.scheme, "https", "Scheme is 'https'";
+		is $url.hostname, "www.tyil.nl", "Host is 'www.tyil.nl'";
+	}
+
+	subtest "https://tyil:donthackme\@www.tyil.nl:8443/a/path/part?foo=bar&perl=6#module", {
+		plan 8;
+
+		my $url = URL.new(
+			scheme => "https",
+			username => "tyil",
+			password => "donthackme",
+			hostname => "www.tyil.nl",
+			port => 8443,
+			path => ["a", "path", "part"],
+			query => { foo => "bar", perl => "6" },
+			fragment => "module",
+		);
+
+		is $url.scheme, "https", "Scheme is https";
+		is $url.username, "tyil", "Username is 'tyil'";
+		is $url.password, "donthackme", "Password is 'donthackme'";
+		is $url.hostname, "www.tyil.nl", "Host is www.tyil.nl";
+		is $url.port, 8443, "Port is 8443";
+		is $url.fragment, "module", "Fragment is 'module'";
+
+		subtest "path", {
+			plan 4;
+
+			my @path = $url.path;
+
+			is @path.elems, 3, "URL path part contains 3 elements";
+			is @path[0], "a", "URL path part 0 is 'a'";
+			is @path[1], "path", "URL path part 1 is 'path'";
+			is @path[2], "part", "URL path part 2 is 'part'";
+		}
+
+		subtest "query", {
+			plan 3;
+
+			my %query = $url.query;
+
+			is %query.elems, 2, "URL query part contains 2 elements";
+			is %query<foo>, "bar", "foo query is bar";
+			is %query<perl>, "6", "perl query is 6";
+		}
+	}
+}
+
+subtest "Grammar", {
+	subtest "https://www.tyil.nl", {
+		plan 8;
+
+		my $url = URL.new("https://www.tyil.nl");
+
+		is $url.username, Str, "Username is empty";
+		is $url.password, Str, "Password is emtpy";
+		is $url.port, Int, "Port is empty";
+		is $url.path, [], "Path is empty";
+		is $url.query, {}, "Query is empty";
+		is $url.fragment, Str, "Fragment is empty";
+
+		is $url.scheme, "https", "Scheme is 'https'";
+		is $url.hostname, "www.tyil.nl", "Host is 'www.tyil.nl'";
+	}
+}
+
+# vim: ft=perl6 noet
diff --git a/t/04-stringification.t b/t/04-stringification.t
new file mode 100644
index 0000000..4a50e5a
--- /dev/null
+++ b/t/04-stringification.t
@@ -0,0 +1,38 @@
+#! /usr/bin/env perl6
+
+use v6.d;
+
+use Test;
+use URL;
+
+plan 2;
+
+subtest "https://www.tyil.nl", {
+	plan 4;
+
+	my $url = URL.new(
+		scheme => "https",
+		hostname => "www.tyil.nl",
+	);
+
+	is $url.Str(:path), "", "Str(:path) = ''";
+	is $url.Str(:query), "", "Str(:query) = ''";
+	is $url.Str(:userinfo), "", "Str(:userinfo) = ''";
+	is ~$url, "https://www.tyil.nl", "Str() = 'https://www.tyil.nl'";
+}
+
+subtest "https://tyil:donthackme\@www.tyil.nl:8443/a/path/part?foo=bar&perl=6#module", {
+	plan 4;
+
+	my $url = URL.new("https://tyil:donthackme\@www.tyil.nl:8443/a/path/part?foo=bar&perl=6#module");
+
+	is $url.Str(:path), "a/path/part", "Str(:path) = 'a/path/part'";
+	is $url.Str(:query), "foo=bar&perl=6", "Str(:query) = 'foo=bar&perl=6'";
+	is $url.Str(:userinfo), "tyil:donthackme", "Str(:userinfo) = 'tyil:donthackme'";
+	is ~$url,
+		"https://tyil:donthackme\@www.tyil.nl:8443/a/path/part?foo=bar&perl=6#module",
+		"Str() = 'https://tyil:donthackme\@www.tyil.nl:8443/a/path/part?foo=bar&perl=6#module'"
+		;
+}
+
+# vim: ft=perl6 noet