diff --git a/extra/farkup/farkup-tests.factor b/extra/farkup/farkup-tests.factor index 1964b2b8a6..ec1b915d4d 100644 --- a/extra/farkup/farkup-tests.factor +++ b/extra/farkup/farkup-tests.factor @@ -2,11 +2,25 @@ USING: farkup kernel tools.test ; IN: temporary [ "" ] [ "-foo" parse-farkup ] unit-test -[ "" ] [ "-foo\n" parse-farkup ] unit-test +[ "\n" ] [ "-foo\n" parse-farkup ] unit-test [ "" ] [ "-foo\n-bar" parse-farkup ] unit-test -[ "" ] [ "-foo\n-bar\n" parse-farkup ] unit-test +[ "\n" ] [ "-foo\n-bar\n" parse-farkup ] unit-test -[ "

bar

" ] [ "-foo\nbar\n" parse-farkup ] unit-test -[ "*foo\nbar\n" parse-farkup ] must-fail +[ "\n

bar\n

" ] [ "-foo\nbar\n" parse-farkup ] unit-test +[ "

*foo\nbar\n

" ] [ "*foo\nbar\n" parse-farkup ] unit-test [ "

Wow!

" ] [ "*Wow!*" parse-farkup ] unit-test [ "

Wow.

" ] [ "_Wow._" parse-farkup ] unit-test + +[ "

*

" ] [ "*" parse-farkup ] unit-test +[ "

*

" ] [ "\\*" parse-farkup ] unit-test +[ "

**

" ] [ "\\**" parse-farkup ] unit-test + +[ "" ] [ "\n\n" parse-farkup ] unit-test +[ "\n" ] [ "\n\n\n" parse-farkup ] unit-test +[ "

foo

bar

" ] [ "foo\n\nbar" parse-farkup ] unit-test + +[ "\n

bar\n

" ] [ "\nbar\n" parse-farkup ] unit-test + +[ "

foo

\n

bar

" ] [ "foo\n\n\nbar" parse-farkup ] unit-test + +[ "" ] [ "" parse-farkup ] unit-test diff --git a/extra/farkup/farkup.factor b/extra/farkup/farkup.factor index 084b1c80cb..aadc61be85 100644 --- a/extra/farkup/farkup.factor +++ b/extra/farkup/farkup.factor @@ -3,23 +3,37 @@ USING: arrays io kernel memoize namespaces peg peg.ebnf sequences strings html.elements xml.entities xmode.code2html splitting io.streams.string html -html.elements sequences.deep unicode.categories ; +html.elements sequences.deep ascii ; +! unicode.categories ; USE: tools.walker IN: farkup MEMO: any-char ( -- parser ) [ drop t ] satisfy ; +: delimiters ( -- string ) + "*_^~%=[-|\\\n" ; inline + MEMO: text ( -- parser ) - [ "*_^~%=[-|\n" member? not ] satisfy repeat1 + [ delimiters member? not ] satisfy repeat1 [ >string escape-string ] action ; +MEMO: delimiter ( -- parser ) + [ dup delimiters member? swap CHAR: \n = not and ] satisfy + [ 1string ] action ; + +: surround-with-foo ( string tag -- seq ) + dup swap swapd 3array ; + : delimited ( str html -- parser ) [ over token hide , - text [ dup swap swapd 3array ] swapd curry action , + text [ surround-with-foo ] swapd curry action , token hide , ] seq* ; +MEMO: escaped-char ( -- parser ) + [ "\\" token hide , any-char , ] seq* [ >string ] action ; + MEMO: strong ( -- parser ) "*" "strong" delimited ; MEMO: emphasis ( -- parser ) "_" "em" delimited ; MEMO: superscript ( -- parser ) "^" "sup" delimited ; @@ -29,6 +43,7 @@ MEMO: h1 ( -- parser ) "=" "h1" delimited ; MEMO: h2 ( -- parser ) "==" "h2" delimited ; MEMO: h3 ( -- parser ) "===" "h3" delimited ; MEMO: h4 ( -- parser ) "====" "h4" delimited ; +MEMO: nl ( -- parser ) "\n" token ; MEMO: 2nl ( -- parser ) "\n\n" token hide ; : render-code ( string mode -- string' ) @@ -60,14 +75,22 @@ MEMO: link ( -- parser ) [ simple-link , labelled-link , ] choice* ; DEFER: line MEMO: list-item ( -- parser ) [ - "-" token hide , - line , - ] seq* - [ "li" swap "li" 3array ] action ; + "-" token hide , line , + ] seq* [ "li" surround-with-foo ] action ; MEMO: list ( -- parser ) list-item "\n" token hide list-of - [ "ul" swap "ul" 3array ] action ; + [ "ul" surround-with-foo ] action ; + +MEMO: table-column ( -- parser ) [ "|" token text ] seq* ; +MEMO: table-row ( -- parser ) + [ + "|" + ] seq* ; +MEMO: table ( -- parser ) + [ + "|" + ] seq* ; MEMO: code ( -- parser ) [ @@ -81,29 +104,26 @@ MEMO: code ( -- parser ) ] seq* [ concat ] action , ] seq* [ first2 swap render-code ] action ; -MEMO: table-column ( -- parser ) [ "|" token text ] seq* ; -MEMO: table-row ( -- parser ) [ ] seq* ; -MEMO: table ( -- parser ) [ "[" ] seq* ; - MEMO: line ( -- parser ) [ text , strong , emphasis , link , superscript , subscript , inline-code , + escaped-char , delimiter , ] choice* repeat1 ; MEMO: paragraph ( -- parser ) + line + "\n" token over 2seq repeat0 + "\n" token "\n" token ensure-not 2seq optional 3seq [ - line [ - dup [ [ blank? ] all? ] deep-all? - [ "

" swap "

" 3array ] unless - ] action , - "\n" token hide , - ] choice* ; + dup [ dup string? not swap [ blank? ] all? or ] deep-all? + [ "

" swap "

" 3array ] unless + ] action ; MEMO: farkup ( -- parser ) [ - list , h1 , h2 , h3 , h4 , code , paragraph , 2nl , - ] choice* repeat1 ; + list , h1 , h2 , h3 , h4 , code , paragraph , 2nl , nl , + ] choice* repeat0 "\n" token optional 2seq ; : parse-farkup ( string -- string' ) farkup parse parse-result-ast diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor index 8298814017..6e42668436 100755 --- a/extra/peg/peg.factor +++ b/extra/peg/peg.factor @@ -306,6 +306,12 @@ MEMO: range ( min max -- parser ) : seq ( seq -- parser ) seq-parser construct-boa init-parser ; +: 2seq ( parser1 parser2 -- parser ) + 2array seq ; + +: 3seq ( parser1 parser2 parser3 -- parser ) + 3array seq ; + : seq* ( quot -- paser ) { } make seq ; inline @@ -343,7 +349,7 @@ MEMO: delay ( parser -- parser ) delay-parser construct-boa init-parser ; MEMO: list-of ( items separator -- parser ) - hide over 2array seq repeat0 [ concat ] action 2array seq [ unclip 1vector swap first append ] action ; + hide over 2seq repeat0 [ concat ] action 2seq [ unclip 1vector swap first append ] action ; MEMO: 'digit' ( -- parser ) [ digit? ] satisfy [ digit> ] action ;