| author | wenzelm | 
| Sat, 17 Sep 2005 18:11:29 +0200 | |
| changeset 17469 | 4524bf3026d3 | 
| parent 16195 | 0eb3c15298cd | 
| child 19305 | 5c16895d548b | 
| permissions | -rw-r--r-- | 
| 6639 | 1 | (* Title: Pure/General/url.ML | 
| 2 | ID: $Id$ | |
| 3 | Author: Markus Wenzel, TU Muenchen | |
| 4 | ||
| 16195 | 5 | Basic URLs, see RFC 1738. | 
| 6639 | 6 | *) | 
| 7 | ||
| 8 | signature URL = | |
| 9 | sig | |
| 14909 | 10 | datatype T = | 
| 11 | File of Path.T | | |
| 12 | RemoteFile of string * Path.T | | |
| 13 | Http of string * Path.T | | |
| 14 | Ftp of string * Path.T | |
| 6639 | 15 | val append: T -> T -> T | 
| 16 | val pack: T -> string | |
| 17 | val unpack: string -> T | |
| 18 | end; | |
| 19 | ||
| 20 | structure Url: URL = | |
| 21 | struct | |
| 22 | ||
| 23 | (* type url *) | |
| 24 | ||
| 14909 | 25 | datatype T = | 
| 26 | File of Path.T | | |
| 27 | RemoteFile of string * Path.T | | |
| 28 | Http of string * Path.T | | |
| 29 | Ftp of string * Path.T; | |
| 6639 | 30 | |
| 31 | ||
| 32 | (* append *) | |
| 33 | ||
| 14909 | 34 | fun append (File p) (File p') = File (Path.append p p') | 
| 35 | | append (RemoteFile (h, p)) (File p') = RemoteFile (h, Path.append p p') | |
| 36 | | append (Http (h, p)) (File p') = Http (h, Path.append p p') | |
| 37 | | append (Ftp (h, p)) (File p') = Ftp (h, Path.append p p') | |
| 6639 | 38 | | append _ url = url; | 
| 39 | ||
| 40 | ||
| 41 | (* pack *) | |
| 42 | ||
| 14909 | 43 | fun pack_path p = if Path.is_current p then "" else Path.pack p; | 
| 6639 | 44 | |
| 14909 | 45 | fun pack (File p) = pack_path p | 
| 46 | | pack (RemoteFile (h, p)) = "file://" ^ h ^ pack_path p | |
| 47 | | pack (Http (h, p)) = "http://" ^ h ^ pack_path p | |
| 48 | | pack (Ftp (h, p)) = "ftp://" ^ h ^ pack_path p; | |
| 6639 | 49 | |
| 50 | ||
| 51 | (* unpack *) | |
| 52 | ||
| 14918 | 53 | local | 
| 54 | ||
| 16195 | 55 | val scan_host = | 
| 56 | (Scan.any1 (not_equal "/" andf Symbol.not_eof) >> implode) --| | |
| 14918 | 57 | Scan.ahead ($$ "/" || Scan.one Symbol.is_eof); | 
| 58 | ||
| 6639 | 59 | val scan_path = Scan.any Symbol.not_eof >> (Path.unpack o implode); | 
| 16195 | 60 | val scan_path_root = Scan.any Symbol.not_eof >> (Path.unpack o implode o cons "/"); | 
| 6639 | 61 | |
| 62 | val scan_url = | |
| 14909 | 63 | Scan.unless (Scan.this_string "file:" || | 
| 64 | Scan.this_string "http:" || Scan.this_string "ftp:") scan_path >> File || | |
| 15175 
b62f7b493360
Fix file:/// and file://localhost/ to give absolute paths
 aspinall parents: 
15174diff
changeset | 65 | Scan.this_string "file:///" |-- scan_path_root >> File || | 
| 
b62f7b493360
Fix file:/// and file://localhost/ to give absolute paths
 aspinall parents: 
15174diff
changeset | 66 | Scan.this_string "file://localhost/" |-- scan_path_root >> File || | 
| 16195 | 67 | Scan.this_string "file://" |-- scan_host -- scan_path >> RemoteFile || | 
| 68 | Scan.this_string "http://" |-- scan_host -- scan_path >> Http || | |
| 69 | Scan.this_string "ftp://" |-- scan_host -- scan_path >> Ftp; | |
| 14918 | 70 | |
| 71 | in | |
| 6639 | 72 | |
| 73 | fun unpack s = Symbol.scanner "Malformed URL" scan_url (Symbol.explode s); | |
| 74 | ||
| 75 | end; | |
| 14918 | 76 | |
| 77 | end; |