1 ! Copyright (C) 2024 Doug Coleman.
2 ! See https://factorcode.org/license.txt for BSD license.
3 USING: accessors calendar checksums combinators.short-circuit
4 http.client io io.directories io.encodings.binary io.files
5 io.files.info io.files.unique io.pathnames kernel math
6 math.order math.parser present sequences shuffle splitting ;
10 : file-too-old-or-not-exists? ( file duration -- ? )
11 [ ?file-info [ created>> ] ?call ]
13 over [ before? ] [ 2drop t ] if ;
15 : delete-when-old ( file duration -- deleted? )
16 dupd file-too-old-or-not-exists? [ ?delete-file t ] [ drop f ] if ;
18 : file-matches-checksum? ( file checksum-type bytes -- ? )
19 [ checksum-file ] dip = ;
21 : delete-when-checksum-mismatches ( file checksum-type bytes -- deleted? )
22 dupdd file-matches-checksum? [ drop f ] [ ?delete-file t ] if ;
24 : file-size= ( path n -- ? ) [ ?file-info [ size>> ] ?call ] dip = ;
26 : file-zero-size? ( path -- ? ) 0 file-size= ;
28 : delete-when-zero-size ( path -- deleted-or-not-exists? )
30 dup file-zero-size? [ ?delete-file t ] [ drop f ] if
35 : delete-when-file-size-mismatches? ( file size -- deleted? )
36 dupd file-size= [ drop f ] [ ?delete-file t ] if ;
38 : download-name ( url -- name )
39 present file-name "?" split1 drop "/" ?tail drop ;
43 : increment-file-extension ( path -- path' )
48 [ 1 + number>string append ]
52 : ?parenthesis-number ( str -- n/str ? )
53 dup { [ "(" head? ] [ ")" tail? ] } 1&&
54 [ rest but-last ?string>number ] [ f ] if ;
56 : increment-file-name ( path -- path' )
58 file-stem " " split1-last
60 [ 1 + number>string "(" ")" surround " " glue ]
61 [ "(1)" append " " glue ] if
66 : find-next-incremented-name ( path -- path' )
68 increment-file-name find-next-incremented-name
71 : next-download-name ( url -- name )
72 download-name find-next-incremented-name ;
74 : http-write-request ( url -- )
75 <get-request> [ write ] with-http-request drop ;
77 : download-temporary-name ( url -- prefix suffix )
78 [ "temp." ".temp" ] dip download-name prepend ;
82 : download-to ( url file -- path )
84 [ download-temporary-name binary ] keep
85 '[ _ http-write-request ] with-unique-file-writer
86 ] dip [ move-file ] keep ;
88 : download-once-to ( url file -- path )
89 dup file-exists? [ nip ] [ download-to ] if ;
91 : download-once ( url -- path )
92 dup download-name download-once-to ;
94 : download-outdated-to ( url file duration -- path )
95 2dup delete-when-old [ drop download-to ] [ drop nip ] if ;
97 : download ( url -- path )
98 dup download-name download-to ;