REBOL [
    Title "File Tools"
    Author: "Brett Handley"
    Purpose: "Define functions that help to manipulate files."
    Date: 13-Apr-2001
    History: [
        1.0.0 [4-Apr-2001 { Original code }  "Brett Handley"]
        1.0.1 [13-Apr-2001 {
            Modified copy-directory to add an include refinement that processes the top most target directory.
            Modified copy-directory to include a verbose option - not that informative yet.
            Modified directory-script to add a probes refinement.
            Added a new function join-path.
        }  "Brett Handley"]
    ]
    Warning: {****

        Make-dir/deep doesn't work on FTP url. Therefore need to test further report as
        bug and perhaps recode some of the functions below.

    **************}
    Comment: {
        Here are some File directory productivity functions. The aim is to be
        able to use them with urls as well.

        In particular:

            read-directory
                Returns a directory tree as a flat block of file!.

            read-directory-tree
                Returns a directory tree as a nested block structure.

            walk-dir
                Will walk a directory tree calling your functions as it goes.

            directory-script
                Generates a script by walking through a directory.

        *** Check the list of supporting scripts you need (below) ***

        %highfun.r is available from www.rebol.org (advanced I think)

        %mime-types.r is only needed if you want to use the copy-directory function
            it is available at www.codeconscious.com/rebol/rebol-scripts.html
    }
]

;
; Support scripts
;

if not :use-script [use-script: :do]   ; Use-script is my script manager
use-script %highfun.r ; See www.rebol.org to download.
use-script %mime-types.r ; See www.codeconscious.com/rebol/rebol-scripts.html


;
; Functions
;


to-winfile: function [
    "Create a windows file specification from the file."
    file-spec
][new-file][
    new-file: replace/all to-string file-spec "/" "\"
    remove head new-file
    replace new-file "\" ":\"
    new-file
]

dirized?: func[x][equal? x dirize x]

folders?: func[ series [series!]][
    "Filters out the folders in a series."
    filter func[x][all [file? x equal? x dirize x]] series
]

files?: func[ series [series!]][
    "Filters out the files in a series."
    filter func[x][all[ file? x not dirized? x]] series
]

assert-is-directory: func[ [catch] dir [file! url!]][
    if not equal? dir dirize dir [
        throw make error! "Can only accept directories."
    ]
]

join-path: func [
    "Joins a path - really just guards against %./"
    base-path [file! url!]
    relative-path [file! url!]
][
    either equal? to-file relative-path %./ [base-path][join base-path relative-path]
]

ensure-directory: function[
    "Creates the directory if it does not exist."
    target-directory
][test-dir][
    assert-is-directory target-directory
    if not exists? test-dir: target-directory [ make-dir/deep test-dir ]
]

read-directory: function [
    "Returns a directory tree as a flat block of file!."
    spec [file! url!]
    /prefix prefix-spec [file! url!] "Joins the prefix onto the spec but does not return it in the result."
    /include "Includes the directory you specify."
][result read-subdirectory refinements actual-spec][
    actual-spec: either prefix [join prefix-spec spec][spec]
    either equal? spec dirize spec [
        result: copy []
        if include [insert tail result spec]
        foreach f read actual-spec [
            either prefix [
                insert tail result read-directory/prefix/include either equal? spec %./ [f][join spec f] prefix-spec
            ][
                insert tail result read-directory/include either equal? spec %./ [f][join spec f]
            ]
        ]
    ][
        result: spec
    ]
    return result
]

read-directory-tree: function [ [catch]
    "Returns a directory tree as a nested block structure."
    spec [file! url!]
    /prefix prefix-spec [file! url!] "Joins the prefix onto the spec but does not return it in the result."
    /include "Includes the specification as the first directory name."
    /filter filter-function [any-function!] "Called for each directory and file."
][result dir-list actual-spec][
    if not filter [filter-function: func[x][true]]
    actual-spec: either prefix [join prefix-spec spec][spec]
    either equal? spec dirize spec [
        result: copy []
        dir-list: read actual-spec
        foreach f dir-list [
            if filter-function f [
                if equal? f dirize f [insert tail result f]
                insert/only tail result read-directory-tree/prefix f actual-spec
            ]
        ]
    ][
        result: spec
    ]
    if include [ result: reduce [spec result]]
    return result
]


directory-tree-walker: context [
    emit-dir-path: none
    emit-file-path: none
    path-stack: none
    directory-name: none
    file-name: none
    push-dir: func [dir] [
        insert tail path-stack dir
        pre-dir-evt emit-dir-path
    ]
    pop-dir: does [
        post-dir-evt emit-dir-path
        remove back tail path-stack
    ]
    file-event: func[file][
        on-file-evt emit-file-path file
    ]
    pre-dir-evt: none
    post-dir-evt: none
    on-file-evt: none
    =file-tree-structure=: [
        any [
            [set directory-name file! into [ (push-dir directory-name) =file-tree-structure= ] (pop-dir) ] |
            set file-name file! (file-event file-name)
        ]
    ]
    set 'walk-dir function [ [catch]
        "Walks a directory tree calling your functions as it goes."
        directory-spec [block! file! url!] "Directory structure as returned from read-directory-tree or directory spec."
        /paths "Includes the paths."
        /relative "Omits the spec from the path."
        /include "Includes the specification."
        /pre-dir pre-dir-handler [any-function!] "Called at start of directory."
        /on-file on-file-handler [any-function!] "Called for each file."
        /post-dir post-dir-handler [any-function!] "Called at end of directory."
    ][directory-data result default-mode parse-result][

        either pre-dir [pre-dir-evt: :pre-dir-handler][pre-dir-evt: none]
        either on-file [on-file-evt: :on-file-handler][on-file-evt: none]
        either post-dir [post-dir-evt: :post-dir-handler][post-dir-evt: none]
        if all [
            not pre-dir not on-file not post-dir
            not relative
            any [file? directory-spec url? directory-spec]
        ][
            default-mode: paths: true
            pre-dir-evt: on-file-evt: function[x][][
                x append result reduce [x info? x]
            ]
            result: copy []
        ]

        either equal? type? directory-spec block! [
            directory-data: directory-spec
            if relative [throw make error! "Cannot use /relative in this mode."]
            if include [throw make error! "Cannot use /include in this mode."]
        ][
            if all [include relative] [throw make error! "Cannot use /include and /relative together."]
            assert-is-directory directory-spec
            either include [
                relative: true
                directory-data: read-directory-tree/include directory-spec
            ][
                directory-data: read-directory-tree directory-spec
            ]
        ]

        either paths [
            either relative [
                emit-dir-path: does [
                    either empty? path-stack [][to-file path-stack]
                ]
                emit-file-path: func[x] [either empty? path-stack [x][join emit-dir-path x]]
            ][
                emit-dir-path: does [
                    either empty? path-stack [directory-spec][join directory-spec to-file path-stack]
                ]
                emit-file-path: func[x] [either empty? path-stack [join directory-spec x][join emit-dir-path x]]
            ]
        ][
            emit-dir-path: does [last path-stack]
            emit-file-path: func[x] [x]
        ]

        path-stack: copy []
        parse-result: parse directory-data =file-tree-structure=
        if not default-mode [result: parse-result]
        RETURN result
    ]
]

directory-script: function [
    "Generates a script by walking through a directory."
    directory-spec [file! url!]
    dir-function [word! path!] "A function call to include in the script."
    file-function [word! path!] "A function call to include in the script."
    /bottom-up "Put directories after their files."
    /subtree "Assume we are working on a subtree."
    /probes "Adds probes to see where the script is up to."
][result dirfunc filefunc walk-result][
    either probes [
        dirfunc: func[x][insert tail result reduce [:dir-function 'probe x]]
        filefunc: func[x][insert tail result reduce [:file-function 'probe x]]
    ][
        dirfunc: func[x][insert tail result reduce [:dir-function x]]
        filefunc: func[x][insert tail result reduce [:file-function x]]
    ]
    result: copy []
    if not exists? directory-spec [return result]
    either subtree [
        either bottom-up [
            walk-result: walk-dir/relative/paths/on-file/post-dir directory-spec :filefunc :dirfunc
        ][
            walk-result: walk-dir/relative/paths/on-file/pre-dir directory-spec :filefunc :dirfunc
        ]
    ][
        either bottom-up [
            walk-result: walk-dir/include/paths/on-file/post-dir directory-spec :filefunc :dirfunc
        ][
            walk-result: walk-dir/include/paths/on-file/pre-dir directory-spec :filefunc :dirfunc
        ]
    ]
    either walk-result [
        return result
    ][none]
]

; Change this to be more predictable and reliable in the face of FTP
; Check if FTP behaves in a relative manner.
; and make this work in a relative manner.

copy-directory: function [
    "Copies one directory to another."
    source-directory [file! url!]
    target-directory [file! url!]
    /include "Includes the target-directory in the processing (creates it)."
    /files "Include files"
    /script "Return the script instead of carrying out the actions."
    /verbose "Shows the file being copied."
][test-dir code copy-dir-func copy-file-func][
    assert-is-directory source-directory
    assert-is-directory target-directory
    target-path: either verbose [ func[x][probe join-path target-directory x] ][
        func[x][join-path target-directory x] ]
    copy-dir-func: function[x][test-dir][
        if not exists? test-dir: target-path x [
            make-dir/deep test-dir
        ]
    ]
    either files [
        copy-file-func: func[x][mime-write target-path x mime-read join source-directory x]
    ][
        copy-file-func: func[x][]
    ]
    code: directory-script/subtree source-directory 'copy-dir-func 'copy-file-func
    if include [
        insert code reduce ['copy-dir-func %./]
    ]
    either script [return code][do code]
]

delete-directory: function [
    "Deletes everything in a directory tree (in a bottom up fashion.)"
    target-directory [file! url!]
    /verbose "Displays what is being deleted."
    /script "Return the script instead of carrying out the deletes."
][code delete-dir-func delete-file-func][
    either verbose [
        delete-dir-func: delete-file-func: func[x][print ["Deleting" x] delete x]
    ][ delete-dir-func: delete-file-func: :delete ]
    code: directory-script/bottom-up target-directory 'delete-dir-func 'delete-file-func
    either script [return code][do code]
]