1 ! Copyright (C) 2008 Doug Coleman.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: combinators continuations fry io.backend io.directories
4 io.directories.hierarchy io.pathnames kernel locals namespaces
5 random.data sequences system vocabs ;
10 HOOK: (touch-unique-file) io-backend ( path -- )
14 : touch-unique-file ( path -- )
15 normalize-path (touch-unique-file) ;
18 SYMBOL: unique-retries
20 10 unique-length set-global
21 10 unique-retries set-global
25 : random-file-name ( -- string )
26 unique-length get random-string ;
28 : retry ( quot: ( -- ? ) n -- )
29 iota swap [ drop ] prepose attempt-all ; inline
33 : unique-file ( prefix suffix -- path )
35 _ _ random-file-name glue
37 ] unique-retries get retry absolute-path ;
39 : unique-files ( prefix suffixes -- paths )
42 _ _ random-file-name '[
44 dup touch-unique-file suffix!
47 [ [ delete-file ] each ] [ rethrow ] bi*
49 ] unique-retries get retry [ absolute-path ] map ;
51 :: cleanup-unique-file ( ..a prefix suffix quot: ( ..a path -- ..b ) -- ..b )
52 prefix suffix unique-file :> path
53 [ path quot call ] [ path delete-file ] [ ] cleanup ; inline
55 :: cleanup-unique-files ( ..a prefix suffixes quot: ( ..a paths -- ..b ) -- ..b )
56 prefix suffixes unique-files :> paths
57 [ paths quot call ] [ paths [ delete-file ] each ] [ ] cleanup ; inline
59 : unique-directory ( -- path )
63 ] unique-retries get retry absolute-path ;
65 :: with-unique-directory ( quot -- path )
66 unique-directory :> path
67 path quot with-directory
70 :: cleanup-unique-directory ( quot -- )
71 unique-directory :> path
72 [ path quot with-directory ]
73 [ path delete-tree ] [ ] cleanup ; inline
76 { [ os unix? ] [ "io.files.unique.unix" ] }
77 { [ os windows? ] [ "io.files.unique.windows" ] }