factor: trim using lists

[factor.git] / extra / site-watcher / site-watcher.factor

diff --git a/extra/site-watcher/site-watcher.factor b/extra/site-watcher/site-watcher.factor
index c538b12ed164ae341e63b90510f50146a2241eab..16deccc8ee2ae88fa3623eca91024dbd5a85120b 100644 (file)
--- a/extra/site-watcher/site-watcher.factor
+++ b/extra/site-watcher/site-watcher.factor
@@ -1,114 +1,50 @@
 ! 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 init
-namespaces prettyprint smtp arrays sequences math math.parser
-strings sets ;
+USING: accessors calendar continuations db http.client init
+kernel math math.parser namespaces sequences site-watcher.db
+site-watcher.email timers ;
 IN: site-watcher
 
-SYMBOL: sites
-
-SYMBOL: site-watcher-from
-
-sites [ H{ } clone ] initialize
+SYMBOL: site-watcher-frequency
+5 minutes site-watcher-frequency set-global
 
-TUPLE: watching emails url last-up up? send-email? error ;
+SYMBOL: running-site-watcher
+[ f running-site-watcher set-global ] "site-watcher" add-startup-hook
 
 <PRIVATE
 
-: ?1array ( array/object -- array )
-    dup array? [ 1array ] unless ; inline
-
-: <watching> ( emails url -- watching )
-    watching new
-        swap >>url
-        swap ?1array >>emails
-        now >>last-up
-        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 -- )
+: check-sites ( seq -- )
     [
-        swap '[ _ http-get 2drop site-good ] [ site-bad ] recover
-    ] assoc-each ;
+        [ dup url>> http-get 2drop site-good ] [ site-bad ] recover
+    ] each ;
 
-: site-up-email ( email watching -- email )
+: site-up-email ( site -- body )
     last-up>> now swap time- duration>minutes 60 /mod
     [ >integer number>string ] bi@
     [ " hours, " append ] [ " minutes" append ] bi* append
-    "Site was down for (at least): " prepend >>body ;
+    "Site was down for (at least): " prepend ;
 
-: ?unparse ( string/object -- string )
-    dup string? [ unparse ] unless ; inline
+: site-down-email ( site -- body ) error>> ;
 
-: site-down-email ( email watching -- email )
-    error>> ?unparse >>body ;
+: send-report ( site -- )
+    [ ]
+    [ dup up?>> [ site-up-email ] [ site-down-email ] if ]
+    [ [ url>> ] [ up?>> "up" "down" ? ] bi " is " glue ] tri
+    send-site-email ;
 
-: send-report ( watching -- )
-    [ <email> ] dip
-    {
-        [ emails>> >>to ]
-        [ drop site-watcher-from get "factor.site.watcher@gmail.com" or >>from ]
-        [ dup up?>> [ site-up-email ] [ site-down-email ] if ]
-        [ [ url>> ] [ up?>> "up" "down" ? ] bi " is " glue >>subject ]
-        [ f >>send-email? drop ]
-    } cleave send-email ;
-
-: report-sites ( assoc -- )
-    [ nip send-email?>> ] assoc-filter
-    [ nip send-report ] assoc-each ;
+: send-reports ( seq -- )
+    [ [ send-report ] each ] unless-empty ;
 
 PRIVATE>
 
-SYMBOL: site-watcher-frequency
-site-watcher-frequency [ 5 minutes ] initialize
-
-: watch-sites ( assoc -- alarm )
-    '[
-        _ [ check-sites ] [ report-sites ] bi
-    ] site-watcher-frequency get every ;
-
-: watch-site ( emails url -- )
-    sites get ?at [
-        [ [ ?1array ] dip append prune ] change-emails drop
-    ] [
-        <watching> dup url>> sites get set-at
-    ] if ;
-
-: delete-site ( url -- )
-    sites get delete-at ;
+: watch-sites ( -- )
+    find-sites check-sites sites-to-report send-reports ;
 
-: unwatch-site ( emails url -- )
-    [ ?1array ] dip
-    sites get ?at [
-        [ diff ] change-emails dup emails>> empty? [
-            url>> delete-site
-        ] [
-            drop
-        ] if 
-    ] [
-        nip delete-site
-    ] if ;
-
-SYMBOL: running-site-watcher
-
-: run-site-watcher ( -- )
-    running-site-watcher get-global [
-        sites get-global watch-sites running-site-watcher set-global
+: run-site-watcher ( db -- )
+    [ running-site-watcher get ] dip '[
+        [ _ [ watch-sites ] with-db ] site-watcher-frequency get every
+        running-site-watcher set
     ] unless ;
 
-[ f running-site-watcher set-global ] "site-watcher" add-init-hook
-
-MAIN: run-site-watcher
+: stop-site-watcher ( -- )
+    running-site-watcher get [ stop-timer ] when* ;