! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs combinators
combinators.short-circuit kernel make math modern modern.slices
-sequences sequences.extras shuffle shuffle.extras splitting
+sequences sequences.extras shuffle combinators.extras splitting
strings unicode ;
IN: modern.html
{ CHAR: \\ CHAR: ' } slice-til-separator-inclusive {
{ f [ to>> over string-expected-got-eof ] }
{ CHAR: ' [ drop ] }
- { CHAR: \\ [ drop next-char-from drop advance-squote-payload ] }
+ { CHAR: \\ [ drop take-char drop advance-squote-payload ] }
} case
] [
string-expected-got-eof
[ "\s\r\n/>" member? ] slice-until ;
: read-value ( n string -- n' string value )
- skip-whitespace next-char-from {
+ skip-whitespace take-char {
{ CHAR: ' [ CHAR: ' read-string >string <squote> ] }
{ CHAR: " [ CHAR: " read-string >string <dquote> ] }
{ CHAR: [ [ "[" throw ] }
">" expect-and-span
<close-tag> ;
- :: shorten* ( vector n -- seq )
- vector n tail
- n vector shorten ;
-
: unclosed-open-tag? ( obj -- ? )
{ [ open-tag? ] [ close-tag>> not ] } 1&& ; inline
! Copyright (C) 2016 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
- USING: accessors assocs kernel math sequences sequences.deep
- sequences.extras combinators.extras strings unicode ;
-USING: accessors assocs fry kernel locals math sequences
++USING: accessors assocs combinators.extras kernel math sequences
+ sequences.deep sequences.extras sequences.private strings
+ unicode ;
IN: modern.slices
: >strings ( seq -- str )
over [ [ 1 - ] dip ?nth ] [ 2drop f ] if ;
! Allow eof
-: next-char-from ( n/f string -- n'/f string ch/f )
+: take-char ( n/f string -- n'/f string ch/f )
over [
2dup ?nth [ [ 1 + ] 2dip ] [ f ] if*
] [
- [ 2drop f ] [ nip ] 2bi f
+ f
] if ;
-: prev-char-from-slice-end ( slice -- ch/f )
- [ to>> 2 - ] [ seq>> ] bi ?nth ;
-
-: prev-char-from-slice ( slice -- ch/f )
- [ from>> 1 - ] [ seq>> ] bi ?nth ;
-
-: next-char-from-slice ( slice -- ch/f )
- [ to>> ] [ seq>> ] bi ?nth ;
-
-: char-before-slice ( slice -- ch/f )
- [ from>> 1 - ] [ seq>> ] bi ?nth ;
-
-: char-after-slice ( slice -- ch/f )
- [ to>> ] [ seq>> ] bi ?nth ;
-
-: find-from* ( ... n seq quot: ( ... elt -- ... ? ) -- ... i elt ? )
+: find-from* ( ... n seq quot: ( ... elt -- ... ? ) -- ... i/f elt ? )
[ find-from ] keepd
pick [ drop t ] [ length -rot nip f ] if ; inline
2dup [ >lower ] bi@ sequence= [ nip ] [ expected-sequence-error ] if ;
: expect-and-span ( n string slice expected-string -- n' string slice' )
- dup length '[ _ take-slice ] 2dip
- rot check-sequence span-slices ;
+ dup length '[ _ take-slice ] 2dip-1up check-sequence span-slices ;
: expect-and-span-insensitive ( n string slice expected-string -- n' string slice' )
- dup length '[ _ take-slice ] 2dip
- rot check-sequence-insensitive span-slices ;
+ dup length '[ _ take-slice ] 2dip-1up check-sequence-insensitive span-slices ;
:: split-slice-back ( slice n -- slice1 slice2 )
slice [ from>> ] [ to>> ] [ seq>> ] tri :> ( from to seq )
: empty-slice-end ( seq -- slice )
[ length dup ] [ ] bi <slice> ; inline
-: empty-slice-from ( n seq -- slice )
- dupd <slice> ; inline
-
:: slice-til-eol ( n string -- n' string slice/f ch/f )
n [
n string '[ "\r\n" member? ] find-from :> ( n' ch )
n string string empty-slice-end f
] if ; inline
-:: merge-slice-til-eol-slash'' ( n string -- n' string slice/f ch/f )
- n [
- n string '[ "\r\n\\" member? ] find-from :> ( n' ch )
- n' string
- n n' string ?<slice>
- ch
- ] [
- n string string empty-slice-end f
- ] if ; inline
-
-: merge-slice-til-whitespace ( n string slice -- n' string slice' )
+: merge-slice-til-whitespace ( n/f string slice -- n'/f string slice' )
pick [
[ slice-til-whitespace drop ] dip merge-slices
] when ;
-: merge-slice-til-eol ( n string slice -- n' string slice' )
- [ slice-til-eol drop ] dip merge-slices ;
-
: slice-between ( slice1 slice2 -- slice )
! ensure-same-underlying
slice-order-by-from
: slice-before ( slice -- slice' )
[ drop 0 ] [ from>> ] [ seq>> ] tri <slice> ;
-: (?nth) ( n/f string/f -- obj/f )
- over [ (?nth) ] [ 2drop f ] if ;
-
-:: merge-slice-til-eol-slash' ( n string slice -- n' string slice/f ch/f )
- n string merge-slice-til-eol-slash'' :> ( n' string' slice' ch' )
- ch' CHAR: \\ = [
- n' 1 + string' (?nth) "\r\n" member? [
- n' 2 + string' slice slice' span-slices merge-slice-til-eol-slash'
- ] [
- "omg" throw
- ] if
- ] [
- n' string' slice slice' span-slices ch'
- ] if ;
-
-! Supports \ at eol (with no space after it)
-: slice-til-eol-slash ( n string -- n' string slice/f ch/f )
- 2dup empty-slice-from merge-slice-til-eol-slash' ;
-
:: slice-til-separator-inclusive ( n string tokens -- n' string slice/f ch/f )
n string '[ tokens member? ] find-from [ dup [ 1 + ] when ] dip :> ( n' ch )
n' string
:: slice-til-string ( n string search -- n' string payload end-string )
search string n subseq-start-from :> n'
n' [ n string search subseq-expected-but-got-eof ] unless
- n' search length + string
+ n' search length + string
n n' string ?<slice>
n' dup search length + string ?<slice> ;
'[ from>> _ + ] [ to>> ] [ seq>> ] tri <slice> ;
: modify-to ( slice n -- slice' )
- [ [ from>> ] [ to>> ] [ seq>> ] tri ] dip
- swap [ + ] dip <slice> ;
+ [ from>> ] swap '[ to>> _ + ] [ seq>> ] tri <slice> ; inline
! { CHAR: \] [ read-closing ] }
! { CHAR: \} [ read-closing ] }
! { CHAR: \) [ read-closing ] }
-: read-closing ( n string tok -- n string tok )
+: read-closing ( n string tok -- n' string tok )
dup length 1 = [
- -1 modify-to [ 1 - ] 2dip
+ -1 modify-to
+ [ 1 - ] 2dip
] unless ;
: rewind-slice ( n string slice -- n' string )
- 2nip [ from>> ] [ seq>> ] bi ; inline
+ 2nip [ from>> ] [ seq>> ] bi ; inline
+
+ :: take-from? ( n seq subseq -- n'/f seq ? )
+ subseq seq n pick length (subseq-start-from) 2nip [
+ n subseq length +
+ seq
+ t
+ ] [
+ n seq f
+ ] if ;
+
+ : check-slice? ( from to seq -- from to seq ? )
+ pick 0 < [
+ f
+ ] [
+ 2dup length > [
+ f
+ ] [
+ t
+ ] if
+ ] if ; inline
+
+ :: take-from-insensitive? ( n seq str -- n'/f seq ? )
+ n str length over + seq check-slice? [
+ subseq str [ >lower ] bi@ sequence= [
+ n str length + seq t
+ ] [
+ n seq f
+ ] if
+ ] [
+ 3drop n seq f
+ ] if ;