#  Copyright (C) Vladimir Prus 2002. Permission to copy, use, modify, sell and
#  distribute this software is granted provided this copyright notice appears in
#  all copies. This software is provided "as is" without express or implied
#  warranty, and with no claim as to its suitability for any purpose.

import sequence ;
import regex ;
import errors : error ;

#    All path manipulations are done with 'normilized' representation. A path
#    may be either
#    - '.', or
#    - ['/'] [ ( '..' '/' )*  (token '/')* token ]
#    In plain english, path can be rooted, '..' elements are allowed only
#    at the beginning, and it never ends in slash, except for path containg
#    of slash only.
#

os = $(OS) ;

#
#    Converts the native path into normalized form.
#
rule make ( native )
{
    return [ make-$(os) $(native) ] ;
}

#
#    Builds native representation of the path
#
rule native ( path )
{
    return [ native-$(os) $(path) ] ;
}

#
#    Tests if a path is rooted
#
rule is_rooted ( path )
{
    return [ SUBST $(path) "^(/)" $1 ] ;
}

#
#    Tests if a path has a parent
#
rule has_parent ( path )
{
    if ( $(path) != . && $(path) != / ) {
        return 1 ;
    } else {
        return ;
    }
}

#
#    Returns parent directory of the path. If no parent exists, error is issued.
#
rule parent ( path )
{
    if [ has_parent $(path) ] {
        # Strip everything at the end of path up to and including first last
        # slash
        local result = [ SUBST $(path) "((.*)/)?[^/]+" $2 ] ;
        if ! $(result) {
            if [ is_rooted $(path) ] {
                result = / ;
            } else {
                result = . ;
            }
        }
        return $(result) ;
    } else {
        error "Path '$(path)' has no parent" ;
    }
}

#
#    Returns path2 such that "[ join path path 2 ] = .".
#    The path may not contain ".." element or be rooted.
#
rule reverse ( path )
{
    if $(path) = . {
        return $(path) ;
    } else {
        local tokens = [ regex.split $(path) "/" ] ;
        local tokens2 ;
        for local i in $(tokens) {
            tokens2 += .. ;
        }
        return [ sequence.join $(tokens2) : "/" ] ;
    }
}

#
#    Contanenates two paths together. The second one cannot be rooted.
#
rule join ( path1 path2 )
{
    if $(path1) = . {
        return $(path2) ;
    } else if $(path1) = / {
        return /$(path2) ;
    } else {

        local parts = [ SUBST $(path2) "((\.\./)*)(.*)" $1 $3 ] ;

        if $(parts[1]) {

            local up_tokens = [ regex.split $(parts[1]) "/" ] ;
            for local i in $(up_tokens[--2]) {
                path1 = [ parent $(path1) ] ;
            }
        }

        return $(path1)/$(parts[2]) ;
    }
}

#
#    If 'path' is relative, it is rooted at 'root'. Otherwise, it's unchanged.
#
rule root_relative_path ( path root )
{
    if [ is_rooted $(path) ] {
        return $(path) ;
    } else {
        return [ join $(root) $(path) ] ;
    }
}

#
#    Implementation
#
rule make-nt ( native )
{
    local tokens = [ regex.split $(native) "[/\\]" ] ;
    local result ;
    # Handle paths ending with slashes
    if $(tokens[-1) {
        result = [ sequence.join $(tokens) : "/" ] ;
    } else {
        result = [ sequence.join $(tokens[--2]) : "/" ] ;
    }
    if [ SUBST $(native) "(^.:)" $(1) ] {
        result = /$(result) ;
    }
    return $(result) ;
}

rule native-nt ( path )
{
    return [ SUBST $(path) "^/?(.*)" $1 ] ;
}



rule __test__ ( ) {


    import assert ;

    assert.true is_rooted "/" ;
    assert.true is_rooted "/foo" ;
    assert.true is_rooted "/foo/bar" ;
    assert.result : is_rooted "." ;
    assert.result : is_rooted "foo" ;
    assert.result : is_rooted "foo/bar" ;

    assert.true has_parent "foo" ;
    assert.true has_parent "foo/bar" ;
    assert.result : has_parent "." ;
    assert.result : has_parent "/" ;

    assert.result "." : parent "foo" ;
    assert.result "/" : parent "/foo" ;
    assert.result "foo/bar" : parent "foo/bar/giz" ;

    assert.result "." : reverse "." ;
    assert.result ".." : reverse "foo" ;
    assert.result "../../.." : reverse "foo/bar/giz" ;

    assert.result "/foo" : join "/" "foo" ;
    assert.result "foo/bar" : join "foo" "bar" ;
    assert.result "foo/bar" : join "foo/giz" "../bar" ;
    assert.result "foo/giz" : join "foo/bar/baz" "../../giz" ;

    local os = nt ;

    assert.result "foo/bar/giz" : make "foo/bar/giz" ;
    assert.result "foo/bar/giz" : make "foo\\bar\\giz" ;
    assert.result "/D:/My Documents" : make "D:\\My Documents" ;

    assert.result "foo/bar/giz" : native "foo/bar/giz" ;
    assert.result "foo" : native "foo" ;
    assert.result "D://My Documents/Work" : native "/D://My Documents/Work" ;

}