diff --git a/basis/http/server/static/static.factor b/basis/http/server/static/static.factor index 6a0ce7da62..8469e90f32 100644 --- a/basis/http/server/static/static.factor +++ b/basis/http/server/static/static.factor @@ -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 ; 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

<-title->

- - - + + + <-?parent-> @@ -98,11 +98,55 @@ TUPLE: file-responder root hook special index-names allow-listings ;
NameLast modifiedSize>Name>Last modified>Size

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 ;