steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

http.server.static: add sorts on columns

char-rename
Jon Harper 2016-06-26 20:35:25 +02:00
parent 679abfa5d7
commit e4f2770456
1 changed files with 53 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

62
basis/http/server/static/static.factor
View File

@ -9,7 +9,7 @@ sorting logging calendar.format accessors splitting io io.files
io.files.info io.directories io.pathnames io.encodings.binary
fry xml.entities destructors urls html xml.syntax
html.templates.fhtml http http.server http.server.responses
http.server.redirection xml.writer locals ;
http.server.redirection xml.writer locals combinators ;
QUALIFIED: sets
TUPLE: file-responder root hook special index-names allow-listings ;
@ -67,8 +67,8 @@ TUPLE: file-responder root hook special index-names allow-listings ;
</tr>
XML] ;
: file>html ( name -- xml )
dup link-info [
: file>html ( name infos -- xml )
[
dup directory?
[ drop "/" append "-" ]
[ size>> number>string ] if
@ -83,13 +83,13 @@ TUPLE: file-responder root hook special index-names allow-listings ;
: listing-title ( -- title )
url get [ path>> "Index of " prepend ] [ "" ] if* ;
:: listing-html-template ( title listing ?parent -- xml )
:: listing-html-template ( title listing ?parent CO-N CO-M CO-S -- xml )
[XML <h1><-title-></h1>
<table>
<tr>
<th>Name</th>
<th>Last modified</th>
<th>Size</th>
<th><a href=<-CO-N->>Name</a></th>
<th><a href=<-CO-M->>Last modified</a></th>
<th><a href=<-CO-S->>Size</a></th>
</tr>
<tr><th colspan="5"><hr/></th></tr>
<-?parent->
@ -98,11 +98,55 @@ TUPLE: file-responder root hook special index-names allow-listings ;
</table>
XML] ;
: sort-column ( -- column ) params get "C" of "N" or ;
: sort-order ( -- order ) params get "O" of "A" or ;
: sort-asc? ( -- ? ) sort-order "A" = ;
: toggle-order ( order -- order' ) "A" = "D" "A" ? ;
: ?toggle-sort-order ( col current-col -- order )
= [ sort-order toggle-order ] [ "A" ] if ;
: sort-orders ( -- CO-N CO-M CO-S )
"N" "M" "S" sort-column [
[ drop "?C=" ";O=" surround ]
[ ?toggle-sort-order ] 2bi append
] curry tri@ ;
: listing-sort-with ( seq quot: ( elt -- key ) -- sortedseq )
sort-with sort-asc? [ reverse ] unless ; inline
: sort-with-name ( {file,info} -- sorted )
[ first ] listing-sort-with ;
: sort-with-modified ( {file,info} -- sorted )
[ second modified>> ] listing-sort-with ;
: size-without-directories ( info -- size )
dup directory? [ drop -1 ] [ size>> ] if ;
: sort-with-size ( {file,info} -- sorted )
[ second size-without-directories ] listing-sort-with ;
: sort-listing ( zipped-files-infos -- sorted )
sort-column {
{ "M" [ sort-with-modified ] }
{ "S" [ sort-with-size ] }
[ drop sort-with-name ]
} case ; inline
: zip-files-infos ( files -- zipped )
dup [ link-info ] map zip ;
: listing ( path -- seq-xml )
[ natural-sort [ file>html ] map ] with-directory-files ;
[
zip-files-infos sort-listing [ first2 file>html ] map
] with-directory-files ;
: listing-body ( title path -- xml )
listing ?parent-dir-link listing-html-template ;
listing ?parent-dir-link sort-orders listing-html-template ;
: directory>html ( path -- xml )
[ listing-title f over ] dip listing-body simple-page ;