From fe2b65d8d2a86db2cdc421f5bb5177cfab5626c0 Mon Sep 17 00:00:00 2001
From: Maximilian Lupke <simply.malu@googlemail.com>
Date: Mon, 22 Feb 2010 21:23:43 +0100
Subject: [PATCH] add "version<=>"

---
 .../semantic-versioning-tests.factor               |  7 ++++++-
 .../semantic-versioning/semantic-versioning.factor | 14 +++++++++++++-
 2 files changed, 19 insertions(+), 2 deletions(-)

diff --git a/extra/semantic-versioning/semantic-versioning-tests.factor b/extra/semantic-versioning/semantic-versioning-tests.factor
index 9745cc94a2..236e802458 100644
--- a/extra/semantic-versioning/semantic-versioning-tests.factor
+++ b/extra/semantic-versioning/semantic-versioning-tests.factor
@@ -1,5 +1,10 @@
-USING: semantic-versioning tools.test ;
+USING: math.order semantic-versioning tools.test ;
 IN: semantic-versioning.tests
 
 [ { 1 0 0 "dev1" } ] [ "1.0.0dev1" split-version ] unit-test
 [ { 1 2 3 } ] [ "1.2.3" split-version ] unit-test
+
+[ +gt+ ] [ "1.2.0dev1" "0.12.1dev2" version<=> ] unit-test
+[ +eq+ ] [ "2.0.0rc1" "2.0.0rc1" version<=> ] unit-test
+[ +lt+ ] [ "1.0.0rc1" "1.0.0" version<=> ] unit-test
+[ +lt+ ] [ "1.0.0rc1" "1.0.0rc2" version<=> ] unit-test
\ No newline at end of file
diff --git a/extra/semantic-versioning/semantic-versioning.factor b/extra/semantic-versioning/semantic-versioning.factor
index 116d5a58a1..c21cca9a7e 100644
--- a/extra/semantic-versioning/semantic-versioning.factor
+++ b/extra/semantic-versioning/semantic-versioning.factor
@@ -1,6 +1,7 @@
 ! Copyright (C) 2010 Maximilian Lupke.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays ascii kernel math.parser sequences splitting ;
+USING: arrays ascii combinators kernel math.order math.parser
+sequences splitting ;
 IN: semantic-versioning
 
 : split-version ( string -- array )
@@ -8,3 +9,14 @@ IN: semantic-versioning
     [ cut [ [ string>number ] tri@ ] dip 4array ]
     [ drop [ string>number ] tri@ 3array ]
     if ;
+
+! okay, not beautiful
+: version<=> ( version1 version2 -- <=> )
+    [ split-version ] bi@
+    {
+        { [ [ unclip ] bi@ swapd <=> dup +eq+ = not ] [ 2nip ] }
+        { [ drop [ unclip ] bi@ swapd <=> dup +eq+ = not ] [ 2nip ] }
+        { [ drop [ unclip ] bi@ swapd <=> dup +eq+ = not ] [ 2nip ] }
+        { [ drop 2dup [ length ] bi@ >=< dup +eq+ = not ] [ 2nip ] }
+        [ drop [ first ] bi@ <=> ]
+    } cond ;