From bc89b6c7d5311c925af7538a5ec56f640427158c Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 5 Apr 2014 15:51:41 -0700 Subject: [PATCH] imap: Add some combinators, fix up some docs, add docs, fix up unit tests. --- extra/imap/imap-docs.factor | 93 +++++++++++++++++++++++++++--------- extra/imap/imap-tests.factor | 24 ++-------- extra/imap/imap.factor | 16 +++++++ 3 files changed, 91 insertions(+), 42 deletions(-) diff --git a/extra/imap/imap-docs.factor b/extra/imap/imap-docs.factor index 07622f22a0..3b82508dee 100644 --- a/extra/imap/imap-docs.factor +++ b/extra/imap/imap-docs.factor @@ -1,9 +1,21 @@ -USING: calendar help.markup help.syntax sequences strings ; +USING: calendar help.markup help.syntax sequences strings +quotations ; IN: imap ARTICLE: "imap" "IMAP library" "The " { $vocab-link "imap" } " vocab implements a large part of the IMAP4rev1 client protocol." $nl +"IMAP is primarily used for retrieving and managing email and folders on an IMAP server. Note that some IMAP servers, such as " { $snippet "imap.gmail.com" } ", require application-specific passwords." +$nl +"Configuration:" +{ $subsections + imap-settings +} +"Combinators:" +{ $subsections + with-imap + with-imap-settings +} "Constructing an IMAP session:" { $subsections } "IMAP folder management:" @@ -23,21 +35,20 @@ $nl { $examples { $code "USING: imap ; " - "\"imap-server\" [ \"mail@example.com\" \"password\" login drop ] with-stream" + """"imap.gmail.com" "email_address@gmail.com" "password" [ list-folders ] with-imap""" } - { $code - "USING: imap ; " - "\"imap-server\" [" - " \"mail@example.com\" \"password\" login drop" - " \"factor\" select-folder drop " - " \"ALL\" \"\" search-mails" - " \"(BODY[HEADER.FIELDS (SUBJECT)])\" fetch-mails" - "] with-stream 3 head ." - "{" - " \"Subject: [Factor-talk] Wiki Tutorial\\r\\n\\r\\n\"" - " \"Subject: Re: [Factor-talk] font-size in listener\\r\\n\\r\\n\"" - " \"Subject: Re: [Factor-talk] Indentation width and other style guidelines\\r\\n\\r\\n\"" - "}" + { $unchecked-example + """USING: imap namespaces ; + \\ imap-settings get-global [ + "factor" select-folder drop + "ALL" "" search-mails + "(BODY[HEADER.FIELDS (SUBJECT)])" fetch-mails + ] with-imap-settings 3 head .""" + """{ + "Subject: [Factor-talk] Wiki Tutorial" + "Subject: Re: [Factor-talk] font-size in listener" + "Subject: Re: [Factor-talk] Indentation width and other style guidelines" +}""" } } ; @@ -81,13 +92,12 @@ HELP: status-folder } { $description "Requests a collection of attributes for the specified folder." } { $examples - { $code - "USE: imap" - "\"imap-host\" [ " - " \"email\" \"pwd\" login drop " - " \"INBOX\" { \"MESSAGES\" \"UNSEEN\" } status-folder " - "] with-stream ." - "{ { \"MESSAGES\" 67 } { \"UNSEEN\" 18 } }" + { $unchecked-example + """USING: imap ; + \\ imap-settings get-global [ + "INBOX" { "MESSAGES" "UNSEEN" } status-folder + ] with-imap-settings""" + """{ { "MESSAGES" 67 } { "UNSEEN" 18 } }""" } } ; @@ -135,3 +145,42 @@ HELP: store-mail { "mail-flags" "Flags of mails after update" } } { $description "Updates the attributes of a set of mails." } ; + +HELP: imap-settings +{ $var-description "A tuple for holding the host, email, and password for an IMAP account. Setting this information as a global variable in your .factor-rc or .factor-bootstrap-rc is recommended." } +{ $examples + "Run the next example and click the link to edit your boot rc:" + { $unchecked-example + + "USING: imap tools.scaffold ; " + "scaffold-factor-boot-rc" + "" + } + "Add the following settings to your bootstrap rc file:" + { $unchecked-example + "USING: imap namespaces ;" + """"imap.gmail.com" "foo@gmail.com" "password" \\ imap-settings set-global""" + "" + } + "Run your boot rc again:" + { $unchecked-example + "USING: command-line ;" + "run-bootstrap-init" + "" + } +} +{ $see-also with-imap-settings } ; + +HELP: with-imap +{ $values + { "host" string } { "email" string } { "password" string } { "quot" quotation } +} +{ $description "Logs into the IMAP server with the provided settings. The quotation should contain code to execute once authentication has aloready occurred." } ; + +HELP: with-imap-settings +{ $values + { "imap-settings" imap-settings } { "quot" quotation } +} +{ $description "Logs into the IMAP server with the provided settings. The quotation should contain code to execute once authentication has aloready occurred." } ; + +{ with-imap with-imap-settings } related-words diff --git a/extra/imap/imap-tests.factor b/extra/imap/imap-tests.factor index 393bcdff37..80e136a0bb 100644 --- a/extra/imap/imap-tests.factor +++ b/extra/imap/imap-tests.factor @@ -4,9 +4,6 @@ math math.parser math.ranges math.statistics namespaces pcre random sequences sets sorting strings tools.test ; IN: imap.tests -! Set these to your email account. -SYMBOLS: email host password ; - : random-ascii ( n -- str ) [ CHAR: a CHAR: z [a,b] random ] "" replicate-as ; @@ -27,22 +24,13 @@ SYMBOLS: email host password ; : sample-mail ( -- mail ) "Fred Foobar " make-mail ; -! Fails unless you have set the settings. -: imap-login ( -- imap4 ) - host get dup [ - email get password get login drop - ] with-stream* ; - -ERROR: host-not-set ; +ERROR: no-imap-test-host ; : get-test-host ( -- host ) - host get dup [ host-not-set throw ] unless ; - -: ensure-host ( -- ) get-test-host drop ; + \ imap-settings get-global host>> [ no-imap-test-host ] unless* ; : imap-test ( result quot -- ) - ensure-host - '[ imap-login _ with-stream ] unit-test ; inline + '[ \ imap-settings get-global _ with-imap-settings ] unit-test ; inline [ t ] [ get-test-host duplex-stream? @@ -62,11 +50,7 @@ ERROR: host-not-set ; [ get-test-host [ f f login ] with-stream ] [ ind>> ] recover ] unit-test -[ f ] [ - get-test-host [ - email get password get login - ] with-stream empty? -] unit-test +[ ] [ \ imap-settings get-global [ ] with-imap-settings ] unit-test ! Newly created and then selected folder is empty. [ 0 { } ] [ diff --git a/extra/imap/imap.factor b/extra/imap/imap.factor index 7fd0ab86eb..2b75fc6f0c 100644 --- a/extra/imap/imap.factor +++ b/extra/imap/imap.factor @@ -168,3 +168,19 @@ PRIVATE> : store-mail ( uids command flags -- mail-flags ) [ comma-list ] 2dip "UID STORE %s %s %s" sprintf "" command-response parse-store-mail ; + +! High level API + +: with-imap ( host email password quot -- ) + [ ] 3dip '[ _ _ login drop @ ] with-stream ; inline + +TUPLE: imap-settings host email password ; + +: ( host email password -- obj ) + imap-settings new + swap >>password + swap >>email + swap >>host ; inline + +: with-imap-settings ( imap-settings quot -- ) + [ [ host>> ] [ email>> ] [ password>> ] tri ] dip with-imap ; inline