Paste: site-watcher

! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alarms assocs calendar combinators
continuations fry http.client io.streams.string kernel
namespaces prettyprint smtp arrays sequences ;
IN: site-watcher

SYMBOL: sites

sites [ H{ } clone ] initialize

TUPLE: watching url email last-up up? send-email? error ;

: <watching> ( url email -- watching )
    watching new
        swap dup array? [ 1array ] unless >>email
        swap >>url
        t >>up? ;

ERROR: not-watching-site url status ;

: set-site-flags ( watching new-up? -- watching )
    [ over up?>> = [ t >>send-email? ] unless ] keep >>up? ;

: site-bad ( watching error -- )
    >>error f set-site-flags drop ;

: site-good ( watching -- )
    f >>error
    t set-site-flags
    now >>last-up drop ;

: check-sites ( assoc -- )
    [
        swap '[ _ http-get 2drop site-good ] [ site-bad ] recover
    ] assoc-each ;

: send-report ( watching -- )
    [ <email> ] dip {
        [ email>> >>to ]
        [ drop "site-watcher@factorcode.org" >>from ]
        [ [ url>> ] [ up?>> "up" "down" ? ] bi " is " glue >>subject ]
        [ error>> unparse >>body ]
        [ f >>send-email? drop ]
    } cleave send-email ;

: report-sites ( assoc -- )
    [ nip send-email?>> ] assoc-filter
    [ nip send-report ] assoc-each ;

: watch-sites ( assoc -- alarm )
    '[ _ [ check-sites ] [ report-sites ] bi ] 5 minutes every ;

: watch-site ( url email -- )
    <watching> dup url>> sites get set-at ;

: run-site-watcher ( -- )
    sites get-global watch-sites drop ;

MAIN: run-site-watcher