extra/urls/urls-tests.factor

   1 IN: urls.tests
   2 USING: urls urls.private tools.test
   3 tuple-syntax arrays kernel assocs
   4 present accessors ;
   5
   6 [ "hello%20world" ] [ "hello world" url-encode ] unit-test
   7 [ "hello world" ] [ "hello%20world" url-decode ] unit-test
   8 [ "~hello world" ] [ "%7ehello+world" url-decode ] unit-test
   9 [ f ] [ "%XX%XX%XX" url-decode ] unit-test
  10 [ f ] [ "%XX%XX%X" url-decode ] unit-test
  11
  12 [ "hello world"   ] [ "hello+world"    url-decode ] unit-test
  13 [ "hello world"   ] [ "hello%20world"  url-decode ] unit-test
  14 [ " ! "           ] [ "%20%21%20"      url-decode ] unit-test
  15 [ "hello world"   ] [ "hello world%"   url-decode ] unit-test
  16 [ "hello world"   ] [ "hello world%x"  url-decode ] unit-test
  17 [ "hello%20world" ] [ "hello world"    url-encode ] unit-test
  18 [ "%20%21%20"     ] [ " ! "            url-encode ] unit-test
  19
  20 [ "\u001234hi\u002045" ] [ "\u001234hi\u002045" url-encode url-decode ] unit-test
  21
  22 [ "a=b&a=c" ] [ { { "a" { "b" "c" } } } assoc>query ] unit-test
  23
  24 [ H{ { "a" "b" } } ] [ "a=b" query>assoc ] unit-test
  25
  26 [ H{ { "a" { "b" "c" } } } ] [ "a=b&a=c" query>assoc ] unit-test
  27
  28 [ "a=3" ] [ { { "a" 3 } } assoc>query ] unit-test
  29
  30 : urls
  31     {
  32         {
  33             TUPLE{ url
  34                 protocol: "http"
  35                 host: "www.apple.com"
  36                 port: 1234
  37                 path: "/a/path"
  38                 query: H{ { "a" "b" } }
  39                 anchor: "foo"
  40             }
  41             "http://www.apple.com:1234/a/path?a=b#foo"
  42         }
  43         {
  44             TUPLE{ url
  45                 protocol: "http"
  46                 host: "www.apple.com"
  47                 path: "/a/path"
  48                 query: H{ { "a" "b" } }
  49                 anchor: "foo"
  50             }
  51             "http://www.apple.com/a/path?a=b#foo"
  52         }
  53         {
  54             TUPLE{ url
  55                 protocol: "http"
  56                 host: "www.apple.com"
  57                 port: 1234
  58                 path: "/another/fine/path"
  59                 anchor: "foo"
  60             }
  61             "http://www.apple.com:1234/another/fine/path#foo"
  62         }
  63         {
  64             TUPLE{ url
  65                 path: "/a/relative/path"
  66                 anchor: "foo"
  67             }
  68             "/a/relative/path#foo"
  69         }
  70         {
  71             TUPLE{ url
  72                 path: "/a/relative/path"
  73             }
  74             "/a/relative/path"
  75         }
  76         {
  77             TUPLE{ url
  78                 path: "a/relative/path"
  79             }
  80             "a/relative/path"
  81         }
  82         {
  83             TUPLE{ url
  84                 path: "bar"
  85                 query: H{ { "a" "b" } }
  86             }
  87             "bar?a=b"
  88         }
  89         {
  90             TUPLE{ url
  91                 protocol: "ftp"
  92                 host: "ftp.kernel.org"
  93                 username: "slava"
  94                 path: "/"
  95             }
  96             "ftp://slava@ftp.kernel.org/"
  97         }
  98         {
  99             TUPLE{ url
 100                 protocol: "ftp"
 101                 host: "ftp.kernel.org"
 102                 username: "slava"
 103                 password: "secret"
 104                 path: "/"
 105             }
 106             "ftp://slava:secret@ftp.kernel.org/"
 107         }
 108     } ;
 109
 110 urls [
 111     [ 1array ] [ [ >url ] curry ] bi* unit-test
 112 ] assoc-each
 113
 114 urls [
 115     swap [ 1array ] [ [ present ] curry ] bi* unit-test
 116 ] assoc-each
 117
 118 [ "b" ] [ "a" "b" url-append-path ] unit-test
 119
 120 [ "a/b" ] [ "a/c" "b" url-append-path ] unit-test
 121
 122 [ "a/b" ] [ "a/" "b" url-append-path ] unit-test
 123
 124 [ "/b" ] [ "a" "/b" url-append-path ] unit-test
 125
 126 [ "/b" ] [ "a/b/" "/b" url-append-path ] unit-test
 127
 128 [ "/xxx/bar" ] [ "/xxx/baz" "bar" url-append-path ] unit-test
 129
 130 [
 131     TUPLE{ url
 132         protocol: "http"
 133         host: "www.apple.com"
 134         port: 1234
 135         path: "/a/path"
 136     }
 137 ] [
 138     TUPLE{ url
 139         protocol: "http"
 140         host: "www.apple.com"
 141         port: 1234
 142         path: "/foo"
 143     }
 144
 145     TUPLE{ url
 146         path: "/a/path"
 147     }
 148
 149     derive-url
 150 ] unit-test
 151
 152 [
 153     TUPLE{ url
 154         protocol: "http"
 155         host: "www.apple.com"
 156         port: 1234
 157         path: "/a/path/relative/path"
 158         query: H{ { "a" "b" } }
 159         anchor: "foo"
 160     }
 161 ] [
 162     TUPLE{ url
 163         protocol: "http"
 164         host: "www.apple.com"
 165         port: 1234
 166         path: "/a/path/"
 167     }
 168
 169     TUPLE{ url
 170         path: "relative/path"
 171         query: H{ { "a" "b" } }
 172         anchor: "foo"
 173     }
 174
 175     derive-url
 176 ] unit-test
 177
 178 [
 179     TUPLE{ url
 180         protocol: "http"
 181         host: "www.apple.com"
 182         port: 1234
 183         path: "/a/path/relative/path"
 184         query: H{ { "a" "b" } }
 185         anchor: "foo"
 186     }
 187 ] [
 188     TUPLE{ url
 189         protocol: "http"
 190         host: "www.apple.com"
 191         port: 1234
 192         path: "/a/path/"
 193     }
 194
 195     TUPLE{ url
 196         path: "relative/path"
 197         query: H{ { "a" "b" } }
 198         anchor: "foo"
 199     }
 200
 201     derive-url
 202 ] unit-test
 203
 204 [
 205     TUPLE{ url
 206         protocol: "http"
 207         host: "www.apple.com"
 208         path: "/xxx/baz"
 209     }
 210 ] [
 211     TUPLE{ url
 212         protocol: "http"
 213         host: "www.apple.com"
 214         path: "/xxx/bar"
 215     }
 216
 217     TUPLE{ url
 218         path: "baz"
 219     }
 220
 221     derive-url
 222 ] unit-test
 223
 224 [ "a" ] [
 225     <url> "a" "b" set-query-param "b" query-param
 226 ] unit-test
 227
 228 [ "foo#3" ] [ URL" foo" clone 3 >>anchor present ] unit-test