URLs are strings with a simple syntax:

  scheme://[username:password@]domain[:port]/path?query_string#fragment_id



Task

Parse a well-formed URL to retrieve the relevant information:   scheme, domain, path, ...



Note:   this task has nothing to do with URL encoding or URL decoding.



According to the standards, the characters:

     ! * ' ( ) ; : @ & = + $ , / ? % # [ ] 
only need to be percent-encoded   (%)   in case of possible confusion.

Also note that the path, query and fragment are case sensitive, even if the scheme and domain are not.

The way the returned information is provided (set of variables, array, structured, record, object,...)
is language-dependent and left to the programmer, but the code should be clear enough to reuse.

Extra credit is given for clear error diagnostics.

   Here is the official standard:     https://tools.ietf.org/html/rfc3986, 
   and here is a simpler   BNF:     http://www.w3.org/Addressing/URL/5_URI_BNF.html.


Test cases

According to T. Berners-Lee

foo://example.com:8042/over/there?name=ferret#nose     should parse into:

   scheme = foo
   domain = example.com
   port = :8042
   path = over/there
   query = name=ferret
   fragment = nose

urn:example:animal:ferret:nose     should parse into:

   scheme = urn
   path = example:animal:ferret:nose

other URLs that must be parsed include:

   jdbc:mysql://test_user:ouupppssss@localhost:3306/sakila?profileSQL=true 
   ftp://ftp.is.co.za/rfc/rfc1808.txt 
   http://www.ietf.org/rfc/rfc2396.txt#header1 
   ldap://[2001:db8::7]/c=GB?objectClass=one&objectClass=two 
   mailto:John.Doe@example.com 
   news:comp.infosystems.www.servers.unix 
   tel:+1-816-555-1212 
   telnet://192.0.2.16:80/ 
   urn:oasis:names:specification:docbook:dtd:xml:4.1.2 


 
Module checkit {
      any=lambda (z$)->{=lambda z$ (a$)->instr(z$,a$)>0}
      one=lambda (z$)->{=lambda z$ (a$)->z$=a$}
      number$="0123456789"
 
      series=Lambda  -> {
                  func=Array([])
                  =lambda  func (&line$, &res$)->{
                        if line$="" then exit
                        k=each(func)
                        def p=0,ok as boolean
                        while k {
                              ok=false :  p++ :  f=array(k)
                              if not f(mid$(line$,p,1)) then exit
                              ok=true
                        }
                        if ok then res$=left$(line$, p) : line$=mid$(line$, p+1)
                        =ok
                  }
      }
 
      is_any=lambda series, any  (c$) ->series(any(c$))
      is_one=lambda series, one  (c$) ->series(one(c$))
      Is_Alpha=series(lambda (a$)-> a$ ~ "[a-zA-Z]")
      Is_digit=series(any(number$))
      Is_hex=any(number$+"abcdefABCDEF")
 
      optionals=Lambda  -> {
                  func=Array([])
                  =lambda  func (&line$, &res$)->{
                        k=each(func)
                        def ok as boolean
                        while k {
                              f=array(k)
                              if f(&line$,&res$) then ok=true : exit
                        }
                        =ok
                  }
      }
      repeated=Lambda  (func)-> {
                  =lambda  func (&line$, &res$)->{
                        def ok as boolean, a$
                        res$=""
                        do {
                              sec=len(line$)
                              if not func(&line$,&a$) then exit
                              res$+=a$
                              ok=true
                        } until line$="" or sec=len(line$)
                        =ok
                  }
      }
 
      oneAndoptional=lambda (func1, func2) -> {
            =lambda  func1, func2 (&line$, &res$)->{
                              def ok as boolean, a$
                              res$=""
                              if not func1(&line$,&res$) then exit
                              if func2(&line$,&a$) then res$+=a$
                              =True
                        }      
      }
      many=Lambda  -> {
                  func=Array([])
                  =lambda  func (&line$, &res$)->{
                        k=each(func)
                        def p=0,ok as boolean, acc$
                        oldline$=line$
                        while k  {
                              ok=false 
                              res$=""
                              if line$="" then exit
                              f=array(k)
                              if not f(&line$,&res$) then exit
                              acc$+=res$
                              ok=true
                         }
                        if not ok then {line$=oldline$}  else res$=acc$
                        =ok
                  }
      }
      is_safe=series(any("$-_@.&"))
      Is_extra=series(any("!*'(),"+chr$(34)))
      Is_Escape=series(any("%"), is_hex, is_hex)
      \\Is_reserved=series(any("=;/#?: "))
      is_xalpha=optionals(Is_Alpha, is_digit, is_safe, is_extra, is_escape)
      is_xalphas=oneAndoptional(is_xalpha,repeated(is_xalpha))
      is_xpalpha=optionals(is_xalpha, is_one("+"))
      is_xpalphas=oneAndoptional(is_xpalpha,repeated(is_xpalpha))
      Is_ialpha=oneAndoptional(Is_Alpha,repeated(is_xpalphas))
      is_fragmentid=lambda is_xalphas (&lines$, &res$) -> {
            =is_xalphas(&lines$, &res$)
      }
      is_search=oneAndoptional(is_xalphas, repeated(many(series(one("+")), is_xalphas)))
      is_void=lambda (f)-> {
            =lambda f (&oldline$, &res$)-> {
                  line$=oldline$
                  if f(&line$, &res$) then {oldline$=line$ } else res$=""
                  =true
            }
      }
      is_scheme=is_ialpha
      is_path=repeated(oneAndoptional(is_void(is_xpalphas), series(one("/"))))
      is_uri=oneAndoptional(many(is_scheme, series(one(":")), is_path), many(series(one("?")),is_search))
      is_fragmentaddress=oneAndoptional(is_uri, many(series(one("#")),is_fragmentid ))
 
      data "foo://example.com:8042/over/there?name=ferret#nose"
      data "urn:example:animal:ferret:nose"
      data "jdbc:mysql://test_user:ouupppssss@localhost:3306/sakila?profileSQL=true "
      data "ftp://ftp.is.co.za/rfc/rfc1808.txt"
      data "http://www.ietf.org/rfc/rfc2396.txt#header1"
      data "ldap://[2001:db8::7]/c=GB?objectClass=one&objectClass=two"
      data "mailto:John.Doe@example.com"
      data "tel:+1-816-555-1212"
      data "telnet://192.0.2.16:80/"
      data "urn:oasis:names:specification:docbook:dtd:xml:4.1.2"
 
      while not empty {
            read What$
            pen 15 {
                  Print What$ 
            }
            a$=""
            If is_scheme(&What$, &a$) Then  Print "Scheme=";a$ : What$=mid$(What$,2)
            If is_path(&What$, &a$) Then {
                  count=0
                  while left$(a$, 1)="/" { a$=mid$(a$,2): count++}
                  if count>1 then {
                        domain$=leftpart$(a$+"/", "/")
                        a$=rightpart$(a$,"/")
                        if domain$<>"" Then Print "Domain:";Domain$
                        if a$<>"" Then Print "Path:";a$
                  } else.if  left$(What$,1) =":" then {
                        Print "path:";a$+What$: What$=""
                  } Else Print  "Data:"; a$
 
            }
 
            if left$(What$,1) =":" then {
                  is_number=repeated(is_digit)
                  What$=mid$(What$,2): If is_number(&What$, &a$) Then Print "Port:";a$
                  if not left$(What$,1)="/" then  exit
                  If is_path(&What$, &a$) Then {
                        while left$(a$, 1)="/" { a$=mid$(a$,2)}
                        if a$<>"" Then Print "Path:";a$
                  }
            }
            if left$(What$, 1)="?" then {
                        What$=mid$(What$,2)
                        If is_search(&What$, &a$) Then  {
                        v$=""
                        if left$(What$, 1)="=" then {
                              What$=mid$(What$,2)
                              If is_search(&What$, &v$) Then  Print "Query:";a$;"=";v$
                        }  else Print "Query:";a$
                        }
            }
            While  left$(What$, 1)="#"  {
            What$=mid$(What$,2)
            if not is_xalphas(&What$, &a$) Then exit
            Print "fragment:";a$
            }
            if What$<>"" Then Print "Data:"; What$
      }     
}
Checkit
 