basis,extra: refactorings to use the ignore-error and ignore-error/f words

char-rename
Björn Lindqvist 2016-11-18 23:39:53 +01:00
parent e4b961a26e
commit 00d4572e6c
7 changed files with 29 additions and 45 deletions

View File

@ -46,4 +46,4 @@ PRIVATE>
{ [ dup ends-with-terminate? ] [ out-d [ f swap <#push> ] map append ] }
[ in-d' out-d [ [ length ] bi@ assert= ] [ <#copy> suffix ] 2bi ]
} cond
] [ dup inference-error? [ drop f ] [ rethrow ] if ] recover ;
] [ inference-error? ] ignore-error/f ;

View File

@ -156,9 +156,7 @@ ERROR: uninferable ;
] if ;
: infer-value ( value-info -- effect/f )
[ (infer-value) ]
[ dup uninferable? [ 2drop f ] [ rethrow ] if ]
recover ;
'[ _ (infer-value) ] [ uninferable? ] ignore-error/f ;
: (value>quot) ( value-info -- quot )
dup literal?>> [

View File

@ -1,8 +1,6 @@
USING: accessors assocs couchdb furnace.auth.providers
json.writer kernel mirrors sequences urls urls.encoding
arrays furnace.auth byte-arrays combinators.short-circuit
strings continuations combinators base64 make
locals namespaces ;
USING: accessors assocs base64 byte-arrays combinators.short-circuit
continuations couchdb fry furnace.auth.providers json.writer kernel
locals make mirrors namespaces sequences strings urls urls.encoding ;
IN: furnace.auth.providers.couchdb
! !!! Implement the authentication protocol for CouchDB.
@ -57,13 +55,10 @@ TUPLE: couchdb-auth-provider
prefix>> [ % url-encode-full % "!" % url-encode-full % ] "" make ;
: (reserve) ( value name -- id/f )
reservation-id
get-url
[
H{ } clone >json swap couch-put
] [
nip dup is-couchdb-conflict-error? [ drop f ] [ rethrow ] if
] recover ;
'[
_ _ reservation-id get-url
H{ } clone swap couch-put
] [ is-couchdb-conflict-error? ] ignore-error/f ;
! Don't reserve false values (e.g. if the email field is f, don't reserve f,
! or the first user who registers without an email address will block all
@ -78,13 +73,11 @@ TUPLE: couchdb-auth-provider
couch-delete drop ;
: unreserve-from-id ( id -- )
[
get-url dup couch-get
'[
_ get-url dup couch-get
"_rev" of "rev" set-query-param
couch-delete drop
] [
dup is-couchdb-not-found-error? [ 2drop ] [ rethrow ] if
] recover ;
] [ is-couchdb-not-found-error? ] ignore-error ;
:: (reserve-multiple) ( hash keys made -- ? )
keys empty? [ t ] [

View File

@ -1,6 +1,6 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: byte-arrays math io.backend io.files.info
USING: byte-arrays fry math io.backend io.files.info
io.files.windows kernel windows.kernel32
windows.time windows.types windows accessors alien.c-types
combinators generalizations system alien.strings
@ -213,12 +213,10 @@ CONSTANT: names-buf-length 16384
] with-destructors ;
! Suppress T{ windows-error f 2 "The system cannot find the file specified." }
: volume>paths ( string -- array )
[ (volume>paths) ] curry
[
dup { [ windows-error? ] [ n>> ERROR_FILE_NOT_FOUND = ] } 1&&
[ drop { } ] [ rethrow ] if
] recover ;
: volume>paths ( string -- array/f )
'[ _ (volume>paths) ] [
{ [ windows-error? ] [ n>> ERROR_FILE_NOT_FOUND = ] } 1&&
] ignore-error/f ;
! Can error with T{ windows-error f 21 "The device is not ready." }
! if there is a D: that is not ready, for instance. Ignore these drives.

View File

@ -1,7 +1,7 @@
! Copyright (C) 2008 Doug Coleman, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.data arrays classes.struct
combinators continuations destructors io.backend
combinators continuations destructors fry io.backend
io.encodings.string io.encodings.utf16n io.files.windows
io.monitors io.pathnames io.ports kernel literals locals make
math sequences system threads windows.errors windows.kernel32
@ -85,8 +85,8 @@ TUPLE: win32-monitor < monitor port ;
dup fill-queue (fill-queue-thread) ;
: fill-queue-thread ( monitor -- )
[ dup fill-queue (fill-queue-thread) ]
[ dup already-disposed? [ 2drop ] [ rethrow ] if ] recover ;
'[ _ dup fill-queue (fill-queue-thread) ]
[ already-disposed? ] ignore-error ;
M:: windows (monitor) ( path recursive? mailbox -- monitor )
[

View File

@ -1,10 +1,9 @@
! Copyright (C) 2003, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors colors colors.constants
combinators.short-circuit compiler.units continuations debugger
fry io io.styles kernel lexer literals locals math math.parser
namespaces parser parser.notes prettyprint sequences sets
source-files.errors system vocabs vocabs.loader
USING: accessors colors colors.constants combinators.short-circuit
compiler.units continuations debugger fry io io.styles kernel lexer
locals math math.parser namespaces parser parser.notes prettyprint
sequences sets source-files.errors system vocabs vocabs.loader
vocabs.parser ;
IN: listener
@ -40,10 +39,8 @@ SYMBOL: handle-ctrl-break
[ [ parse-lines ] with-ctrl-break ] with-compilation-unit ;
: read-quot-step ( lines -- quot/f )
[ parse-lines-interactive ] [
dup error>> unexpected-eof?
[ 2drop f ] [ rethrow ] if
] recover ;
'[ _ parse-lines-interactive ]
[ error>> unexpected-eof? ] ignore-error/f ;
: read-quot-loop ( stream accum -- quot/f )
over stream-readln dup [

View File

@ -1,9 +1,9 @@
! Copyright (C) 2008, 2009 Alex Chapman
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs continuations debugger hashtables http
USING: accessors assocs continuations debugger fry hashtables http
http.client io io.encodings.string io.encodings.utf8 json.reader
json.writer kernel locals make math math.parser namespaces sequences
strings urls urls.encoding vectors ;
strings urls.encoding vectors ;
IN: couchdb
! NOTE: This code only works with the latest couchdb (0.9.*), because old
@ -111,9 +111,7 @@ C: <db> db
f swap db-url couch-put response-ok* ;
: ensure-db ( db -- )
[ create-db ] [
dup file-exists-error? [ 2drop ] [ rethrow ] if
] recover ;
'[ _ create-db ] [ file-exists-error? ] ignore-error ;
: delete-db ( db -- )
db-url couch-delete drop ;