src/Pure/General/url.ML
author wenzelm
Wed, 12 May 1999 16:51:52 +0200
changeset 6639 d399db16964c
child 8806 a202293db3f6
permissions -rw-r--r--
Basic URLs.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
6639
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
     1
(*  Title:      Pure/General/url.ML
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
     2
    ID:         $Id$
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
     3
    Author:     Markus Wenzel, TU Muenchen
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
     4
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
     5
Basic URLs.
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
     6
*)
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
     7
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
     8
signature URL =
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
     9
sig
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
    10
  type T
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
    11
  val file: Path.T -> T
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
    12
  val http: string * Path.T -> T
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
    13
  val ftp: string * Path.T -> T
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
    14
  val append: T -> T -> T
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
    15
  val pack: T -> string
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
    16
  val unpack: string -> T
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
    17
end;
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
    18
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
    19
structure Url: URL =
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
    20
struct
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
    21
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
    22
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
    23
(* type url *)
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
    24
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
    25
datatype scheme = File | Http of string | Ftp of string;
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
    26
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
    27
datatype T = Url of scheme * Path.T;
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
    28
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
    29
fun file p = Url (File, p);
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
    30
fun http (h, p) = Url (Http h, p);
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
    31
fun ftp (h, p) = Url (Ftp h, p);
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
    32
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
    33
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
    34
(* append *)
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
    35
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
    36
fun append (Url (s, p)) (Url (File, p')) = Url (s, Path.append p p')
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
    37
  | append _ url = url;
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
    38
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
    39
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
    40
(* pack *)
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
    41
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
    42
fun pack_scheme File = ""
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
    43
  | pack_scheme (Http host) = "http://" ^ host
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
    44
  | pack_scheme (Ftp host) = "ftp://" ^ host;
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
    45
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
    46
fun pack (Url (s, p)) = pack_scheme s ^ (if Path.is_current p then "" else Path.pack p);
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
    47
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
    48
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
    49
(* unpack *)
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
    50
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
    51
fun scan_lits [] x = ("", x)
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
    52
  | scan_lits (c :: cs) x = (($$ c -- scan_lits cs) >> op ^) x;
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
    53
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
    54
val scan_literal = scan_lits o Symbol.explode;
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
    55
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
    56
val scan_path = Scan.any Symbol.not_eof >> (Path.unpack o implode);
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
    57
val scan_host = Scan.any1 (not_equal "/" andf Symbol.not_eof) >> implode;
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
    58
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
    59
val scan_url =
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
    60
  scan_literal "http://" |-- scan_host -- scan_path >> http ||
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
    61
  scan_literal "ftp://" |-- scan_host -- scan_path >> ftp ||
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
    62
  Scan.unless (scan_literal "http:" || scan_literal "ftp:") scan_path >> file;
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
    63
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
    64
fun unpack s = Symbol.scanner "Malformed URL" scan_url (Symbol.explode s);
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
    65
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
    66
d399db16964c Basic URLs.
wenzelm
parents:
diff changeset
    67
end;