From: John Benediktsson <mrjbq7@gmail.com>
Date: Tue, 24 Jul 2012 16:49:45 +0000 (-0700)
Subject: txon: adding reader and writer words for TXON format.
X-Git-Tag: 0.97~2792
X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=06469a4865c021baf956996876177f3ec4c30da0

txon: adding reader and writer words for TXON format.
---

diff --git a/extra/txon/authors.txt b/extra/txon/authors.txt
new file mode 100644
index 0000000000..e091bb8164
--- /dev/null
+++ b/extra/txon/authors.txt
@@ -0,0 +1 @@
+John Benediktsson
diff --git a/extra/txon/summary.txt b/extra/txon/summary.txt
new file mode 100644
index 0000000000..9c32c97e68
--- /dev/null
+++ b/extra/txon/summary.txt
@@ -0,0 +1 @@
+TXON (http://www.hxa.name/txon/) reader and writer
diff --git a/extra/txon/txon-tests.factor b/extra/txon/txon-tests.factor
new file mode 100644
index 0000000000..6d294c7419
--- /dev/null
+++ b/extra/txon/txon-tests.factor
@@ -0,0 +1,76 @@
+
+USING: tools.test txon ;
+
+IN: txon.tests
+
+[ "ABC" ] [ "ABC" >txon ] unit-test
+
+[ "A\\`C" ] [ "A`C" >txon ] unit-test
+
+[ "123" ] [ 123 >txon ] unit-test
+
+[ "1\n2\n3" ] [ { 1 2 3 } >txon ] unit-test
+
+[ "a:`123`\nb:`456`" ] [ H{ { "a" 123 } { "b" 456 } } >txon ] unit-test
+
+[ "foo" ] [ "foo" txon> ] unit-test
+
+[ "foo" ] [ "   foo   " txon> ] unit-test
+
+[ H{ { "foo" "" } } ]
+[ "foo:``" txon> ] unit-test
+
+[ H{ { "foo" " " } } ]
+[ "foo:` `" txon> ] unit-test
+
+[ H{ { "name" "value" } } ]
+[ "name:`value`" txon> ] unit-test
+
+[ H{ { "name" "value" } } ]
+[ "  name:`value`  " txon> ] unit-test
+
+[ H{ { "foo`bar" "value" } } ]
+[ "foo\\`bar:`value`" txon> ] unit-test
+
+[ H{ { "foo" "bar`baz" } } ]
+[ "foo:`bar\\`baz`" txon> ] unit-test
+
+[ { H{ { "name1" "value1" } } H{ { "name2" "value2" } } } ]
+[ "name1:`value1`name2:`value2`" txon> ] unit-test
+
+[ H{ { "name1" H{ { "name2" "nested value" } } } } ]
+[ "name1:`  name2:`nested value` `" txon> ] unit-test
+
+[ "name1:`name2:`nested value``" ]
+[
+    H{ { "name1" H{ { "name2" "nested value" } } } } >txon
+] unit-test
+
+[
+    H{
+        { "name1" H{ { "name2" "value2" } { "name3" "value3" } } }
+    }
+] [
+    "
+    name1:`
+        name2:`value2`
+        name3:`value3`
+    `
+    " txon>
+] unit-test
+
+[
+    H{
+        { "name1" H{ { "name2" H{ { "name3" "value3" } } } } }
+    }
+] [
+    "
+    name1:`
+        name2:`
+            name3:`value3`
+        `
+    `
+    " txon>
+] unit-test
+
+[ H{ { "a" { "1" "2" "3" } } } ] [ "a:`1\n2\n3`" txon> ] unit-test
diff --git a/extra/txon/txon.factor b/extra/txon/txon.factor
new file mode 100644
index 0000000000..097ecb3014
--- /dev/null
+++ b/extra/txon/txon.factor
@@ -0,0 +1,79 @@
+! Copyright (C) 2011 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: assocs combinators combinators.short-circuit formatting
+grouping hashtables io kernel make math math.parser regexp
+sequences splitting strings unicode.categories ;
+
+IN: txon
+
+<PRIVATE
+
+: decode-value ( string -- string' )
+    R" \\`" "`" re-replace ;
+
+: `? ( ch1 ch2 -- ? )
+    [ CHAR: \ = not ] [ CHAR: ` = ] bi* and ;
+
+: (find-`) ( string -- n/f )
+    2 clump [ first2 `? ] find drop [ 1 + ] [ f ] if* ;
+
+: find-` ( string -- n/f )
+    dup ?first CHAR: ` = [ drop 0 ] [ (find-`) ] if ;
+
+: parse-name ( string -- remain name )
+    ":`" split1 swap decode-value ;
+
+DEFER: name/values
+
+: (parse-value) ( string -- values )
+    decode-value string-lines dup length 1 = [ first ] when ;
+
+: parse-value ( string -- remain value )
+    dup find-` [
+        dup 1 - pick ?nth CHAR: : =
+        [ drop name/values ] [ cut swap (parse-value) ] if
+        [ rest [ blank? ] trim-head ] dip
+    ] [ f swap ] if* ;
+
+: (name=value) ( string -- remain term )
+    parse-name [ parse-value ] dip associate ;
+
+: name=value ( string -- remain term )
+    [ blank? ] trim
+    ":`" over subseq? [ (name=value) ] [ f swap ] if ;
+
+: name/values ( string -- remain terms )
+    [ dup { [ empty? not ] [ first CHAR: ` = not ] } 1&& ]
+    [ name=value ] produce assoc-combine ;
+
+: parse-txon ( string -- objects )
+    [ dup empty? not ] [ name=value ] produce nip ;
+
+PRIVATE>
+
+: txon> ( string -- object )
+    parse-txon dup length 1 = [ first ] when ;
+
+<PRIVATE
+
+: encode-value ( string -- string' )
+    R" `" "\\`" re-replace ;
+
+PRIVATE>
+
+GENERIC: >txon ( object -- string )
+
+M: sequence >txon
+    [ >txon ] map "\n" join ;
+
+M: assoc >txon
+    >alist [
+        first2 [ encode-value ] [ >txon ] bi* "%s:`%s`" sprintf
+    ] map "\n" join ;
+
+M: string >txon
+    encode-value ;
+
+M: number >txon
+    number>string >txon ;