Paste: retries

Author: erg
Mode: factor
Date: Tue, 30 Mar 2021 14:24:21
Plain Text | 
! Copyright (C) 2021 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel math math.functions math.ranges
namespaces random threads ;
IN: retries

TUPLE: retries-strategy ;
TUPLE: retries-strategy-immediate < retries-strategy ;
C: <retries-strategy-immediate> retries-strategy-immediate
TUPLE: retries-strategy-random < retries-strategy lo hi ;
C: <retries-strategy-random> retries-strategy-random
TUPLE: retries-strategy-exponential < retries-strategy exp nanos ;
C: <retries-strategy-exponential> retries-strategy-exponential

TUPLE: retries count max-retries strategy ;
: <retries> ( max-retries strategy -- retries )
    retries new
        0 >>count
        swap >>strategy
        swap >>max-retries ; inline

: retry? ( retries -- ? )
    [ count>> ] [ max-retries>> ] bi < ;

GENERIC: next-retry ( retries retry-strategy -- nanos/timestamp )

M: retries-strategy-immediate next-retry 2drop 0 ;
M: retries-strategy-random next-retry
    nip [ lo>> ] [ hi>> ] bi [a,b] random ;
M: retries-strategy-exponential next-retry
    [ count>> ] [ [ exp>> ^ ] [ nanos>> * ] bi ] bi* ;

SYMBOL: current-retries
ERROR: retries-failed retry quot ;

: with-retries ( retries quot -- )
    [ current-retries ] dip dup '[
        [
            current-retries get
            dup retry? [
                [
                    dup strategy>> next-retry
                    [ dup number>string "sleeping " prepend . sleep ] unless-zero
                    @
                ] keep swap [ drop f ] [ [ 1 + ] change-count drop t ] if
            ] [
                _ retries-failed
            ] if
        ] loop
    ] with-variable ; inline

: with-n-immediate-retries ( n quot -- )
    [ <retries-strategy-immediate> <retries> ] dip with-retries ; inline

: with-n-random-retries ( n lo hi quot -- )
    [ <retries-strategy-random> <retries> ] dip with-retries ; inline

: with-n-exponential-retries ( n exp nanos quot -- )
    [ <retries-strategy-exponential> <retries> ] dip with-retries ; inline



10 [ 5 random dup . 30 = ] with-n-immediate-retries

10 500,000,000 1,000,000,000  [ 5 random dup . 30 = ] with-n-random-retries

10 1.5 100,000,000 [ 5 random dup . 30 = ] with-n-exponential-retries

Annotation: retries better

Author: erg
Mode: factor
Date: Thu, 1 Apr 2021 04:03:38
Plain Text | 
! Copyright (C) 2021 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays calendar combinators combinators.extras
continuations kernel math math.functions math.parser math.ranges
namespaces prettyprint random sequences system threads ;
IN: retries

TUPLE: retries count time-strategy errors ;
: new-retries ( class -- obj )
    new
        0 >>count
        V{ } clone >>errors ; inline

TUPLE: counted-retries < retries max-retries ;
: <counted-retries> ( time-strategy max-retries -- retries )
    counted-retries new-retries
        swap >>max-retries
        swap >>time-strategy ; inline

TUPLE: sequence-retries < retries seq ;
: <sequence-retries> ( time-strategy seq -- retries )
    sequence-retries new-retries
        swap >>seq
        swap >>time-strategy ; inline

GENERIC: retries* ( time-strategy seq/n -- obj )
M: integer retries* <counted-retries> ;
M: sequence retries* <sequence-retries> ;

TUPLE: time-strategy ;
TUPLE: immediate < time-strategy ;
C: <immediate> immediate

TUPLE: random-wait < time-strategy lo hi ;
C: <random-wait> random-wait

TUPLE: exponential-wait < time-strategy exp nanos ;
C: <exponential-wait> exponential-wait

GENERIC: retry-obj ( retries -- elt/obj/index retry? )
GENERIC: retry-sleep-time ( retries time-strategy -- nanos/timestamp/0 )
: next-retry ( retries -- elt/obj/index nanos/timestamp/0 ? )
    {
        [ retry-obj ]
        [ [ ] [ time-strategy>> ] bi retry-sleep-time ]
        [ pick [ [ 1 + ] change-count drop ] [ drop ] if swap ]
    } cleave ;

M: immediate retry-sleep-time 2drop 0 ;
M: random-wait retry-sleep-time nip [ lo>> ] [ hi>> ] bi [a,b] random ;
M: exponential-wait retry-sleep-time [ count>> ] [ [ exp>> ^ ] [ nanos>> * ] bi ] bi* ;

: nth* ( n seq -- elt/f ? ) 2dup bounds-check? [ nth t ] [ 2drop f f ] if ;

M: counted-retries retry-obj [ count>> ] [ max-retries>> ] bi dupd < ;
M: sequence-retries retry-obj [ count>> ] [ seq>> ] bi nth* ;

SYMBOL: current-retries
ERROR: retries-failed retries quot ;

: with-retries ( retries quot -- result )
    [ current-retries ] dip dup '[
        [
            current-retries get next-retry [
                [ sleep ] unless-zero
                _ [ f ] compose [
                    current-retries get count>>
                    now 4array current-retries get errors>> push f t
                ] recover
            ] [
                current-retries get _ retries-failed
            ] if
        ] loop1
    ] with-variable ; inline

: retries ( quot time-strategy n/seq -- result )
    retries* swap with-retries ; inline


[ "/bin" XATTR_NOFOLLOW swapd list-xattrs-impl ]
<immediate> { 2 4 100000 } retries .

New Annotation

Summary:
Author:
Mode:
Body: