Corrected incorrect regular expressions in the file module. Approved: Gabriel Petrovay, Paul J. Lucas

xquery version "3.0";

(:
 : Copyright 2006-2009 The FLWOR Foundation.
 :
 : Licensed under the Apache License, Version 2.0 (the "License");
 : you may not use this file except in compliance with the License.
 : You may obtain a copy of the License at
 :
 : http://www.apache.org/licenses/LICENSE-2.0
 :
 : Unless required by applicable law or agreed to in writing, software
 : distributed under the License is distributed on an "AS IS" BASIS,
 : WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 : See the License for the specific language governing permissions and
 : limitations under the License.
 :)

(:~
 : This module implements the file API EXPath specification available at http://expath.org/spec/file
 : @author Gabriel Petrovay, Matthias Brantner, Markus Pilman
 : @see http://expath.org/spec/file
 :)
module namespace file = "http://expath.org/ns/file";

import schema namespace output = "http://www.w3.org/2010/xslt-xquery-serialization";
declare namespace ann = "http://www.zorba-xquery.com/annotations";
declare namespace ver = "http://www.zorba-xquery.com/options/versioning";
declare option ver:module-version "2.0";

(:~
 : Appends a sequence of items to a file. If the file pointed by
$file

 : does not exist, a new file will be created. Before writing to the file, the items
 : are serialized according to the
$serializer-params
.
 :
 : The semantics of
$serializer-params
 is the same as for the
 :
$params
 parameter of the fn:serialize
 : function.
 :
 : @param $file The path/URI of the file to write the content to.
 : @param $content The content to be serialized to the file.
 : @param $serializer-params Parameter to control the serialization of the
 :    content.
 : @return The empty sequence.
 : @error file:FOFL0004 If
$file
 points to a directory.
 : @error file:FOFL9999 If any other error occurs.
 :)
declare %ann:sequential function file:append(
  $file as xs:string,
  $content as item()*,
  $serializer-params as element(output:serialization-parameters)?
) as empty-sequence()
{
  file:append-text(
    $file,
    fn:serialize($content, $serializer-params))
};

(:~
 : Appends a sequence of Base64 items as binary to a file. If the file pointed
 : by
$file
 does not exist, a new file will be created.
 :
 : @param $file The path/URI of the file to write the content to.
 : @param $content The content to be serialized to the file.
 : @return The empty sequence.
 : @error file:FOFL0004 If
$file
 points to a directory.
 : @error file:FOFL9999 If any other error occurs.
 :)
declare %ann:sequential function file:append-binary(
  $file as xs:string,
  $content as xs:base64Binary*
) as empty-sequence() external;

(:~
 : Appends a sequence of string items to a file.
 :
 : @param $file The path/URI of the file to write the content to.
 : @param $content The content to be serialized to the file.
 : @return The empty sequence.
 : @error file:FOFL0004 If
$file
 points to a directory.
 : @error file:FOFL9999 If any other error occurs.
 :)
declare %private %ann:sequential function file:append-text(
  $file as xs:string,
  $content as xs:string*
) as empty-sequence() external;

(:~
 : Copies a file or a directory given a source and a destination path/URI.
 :
 : @param $source The path/URI of the file or directory to copy.
 : @param $destination The destination path/URI.
 : @return The empty sequence.
 : @error file:FOFL0001 If the
$source
 path does not exist.
 : @error file:FOFL0002 If the computed destination points to a file system item
 :    with a different type than the
$source
.
 : @error file:FOFL0003 If
$destination
 does not exist and it's
 :    parent directory does not exist either.
 : @error file:FOFL9999 If any other error occurs.
 :)
declare %ann:nondeterministic %ann:sequential function file:copy(
  $source as xs:string,
  $destination as xs:string
) as empty-sequence()
{
  if (file:exists($source)) then
    if (file:is-directory($source)) then
      file:copy-directory-impl($source, $destination)
    else
      file:copy-file-impl($source, $destination)
  else
    fn:error(xs:QName("file:FOFL0001"), fn:concat("The source path does not exists: ", $source))
};

(:~
 : Copies a file given a source and a destination path/URI.
 :
 : @param $sourceFile The path/URI of the file to copy.
 : @param $destination The destination path/URI.
 : @return The empty sequence.
 : @error file:FOFL0001 If the
$source
 path does not exist.
 : @error file:FOFL0002 If the computed destination points to directory.
 : @error file:FOFL0003 If
$destination
 does not exist and it's
 :    parent directory does not exist either.
 : @error file:FOFL0004 If
$sourceFile
 points to a directory.
 : @error file:FOFL9999 If any other error occurs.
 :)
declare %private %ann:sequential function file:copy-file-impl(
  $sourceFile as xs:string,
  $destination as xs:string
) as empty-sequence() external;

(:~
 : Copies a source directory recursively to a destination path/URI.
 :
 : @param $sourceDir The path/URI of the directory to copy.
 : @param $destination The destination path/URI.
 : @return The empty sequence.
 : @error file:FOFL0001 If the
$source
 path does not exist.
 : @error file:FOFL0002 If
$destination
 points to an existing file.
 : @error file:FOFL0003 If
$destination
 does not exist and it's
 :    parent directory does not exist either.
 : @error file:FOFL9999 If any other error occurs.
 :)
declare %private %ann:nondeterministic %ann:sequential function file:copy-directory-impl(
  $sourceDir as xs:string,
  $destination as xs:string
) as empty-sequence()
{
  if (file:is-file($destination)) then
    fn:error(xs:QName("file:FOFL0002"), fn:concat("The specified destination path already exists: ", $destination))
  else if (fn:not(file:exists($destination))) then
    let $dirname := file:dir-name($destination)
    return
      if (fn:not(file:exists($dirname))) then
        fn:error(xs:QName("file:FOFL0003"), fn:concat("The destination directory does not exist: ", $dirname))
      else
        {
          file:create-directory($destination);
          file:copy-directory-content($sourceDir, $destination)
        }

  else
    let $basename := file:base-name($sourceDir)
    let $newdir := fn:concat($destination, file:directory-separator(), $basename)
    return
      {
        file:create-directory($newdir);
        file:copy-directory-content($sourceDir, $newdir)
      }
};

(:~
 : Copies the content of a given directory to an existing destination
 : directory.
 :
 : @param $sourceDir The path/URI of the directory to copy the content from.
 : @param $destination The destination directory path/URI.
 : @return The empty sequence.
 : @error file:FOFL0001 If the
$source
 path does not exist.
 : @error file:FOFL0003 If
$destination
 directory does not exist.
 : @error file:FOFL9999 If any other error occurs.
 :)
declare %private %ann:nondeterministic %ann:sequential function file:copy-directory-content(
  $sourceDir as xs:string,
  $destination as xs:string
) as empty-sequence()
{
  if (file:is-directory($destination)) then
    for $item in file:list($sourceDir)
    let $fullPath := fn:concat($sourceDir, file:directory-separator(), $item)
    return
      file:copy($fullPath, $destination)
  else
    fn:error(xs:QName("file:FOFL0003"), fn:concat("The specified destination directory does not exist: ", $destination))
};

(:~
 : Creates a directory.
 :
 : The operation is will create all the missing parent directories from the
 : given path.
 :
 : @param $dir The path/URI denoting the directory to be created.
 : @return The empty sequence.
 : @error file:FOFL0002 If the directory cannot be created because of an already
 :    existing file.
 : @error file:FOFL9999 If any other error occurs.
 :)
declare %ann:sequential function file:create-directory(
  $dir as xs:string
) as empty-sequence() external;

(:~
 : Deletes a file or a directory from the file system.
 :
 : If
$path
 points to a directory the directory will be deleted
 : recursively.
 :
 : @param $path The path/URI of the file or directory to delete.
 : @return The empty sequence.
 : @error file:FOFL0001 If the
$path
 path does not exist.
 : @error file:FOFL9999 If any other error occurs.
 :)
declare %ann:nondeterministic %ann:sequential function file:delete(
  $path as xs:string
) as empty-sequence()
{
  if (file:exists($path)) then
    if (file:is-directory($path)) then
      file:delete-directory-impl($path)
    else
      file:delete-file-impl($path)
  else
    fn:error(xs:QName("file:FOFL0001"), fn:concat("The path does not exists: ", $path))
};

(:~
 : Deletes a file from the file system.
 :
 : @param $file The path/URI of the file to delete.
 : @return The empty sequence.
 : @error file:FOFL0001 If the
$file
 path does not exist.
 : @error file:FOFL9999 If any other error occurs.
 :)
declare %private %ann:sequential function file:delete-file-impl(
  $file as xs:string
) as empty-sequence() external;

(:~
 : Deletes a directory from the file system.
 :
 : @param $dir The path/URI of the directory to delete.
 : @return The empty sequence.
 : @error file:FOFL0001 If the
$dir
 path does not exist.
 : @error file:FOFL0003 If
$dir
 does not point to a directory.
 : @error file:FOFL9999 If any other error occurs.
 :)
declare %private %ann:nondeterministic %ann:sequential function file:delete-directory-impl(
  $dir as xs:string
) as empty-sequence()
{
  for $item in file:list($dir)
  let $fullPath := fn:concat($dir, file:directory-separator(), $item)
  return
    if (file:is-directory($fullPath)) then
      file:delete-directory-impl($fullPath);
    else
      file:delete-file-impl($fullPath);

  file:delete-file-impl($dir)
};

(:~
 : Tests if a path/URI is already used in the file system.
 :
 : @param $path The path/URI to test for existence.
 : @return true if the path/URI points to an existing file system item.
 :)
declare %ann:nondeterministic function file:exists(
  $path as xs:string
) as xs:boolean external;

(:~
 : Tests if a path/URI points to a directory. On UNIX-based systems, the root
 : and the volume roots are considered directories.
 :
 : @param $dir The path/URI to test.
 : @return true if the path/URI points to a directory.
 :)
declare %ann:nondeterministic function file:is-directory(
  $dir as xs:string
) as xs:boolean external;

(:~
 : Tests if a path/URI points to a file.
 :
 : @param $dir The path/URI to test.
 : @return true if the path/URI points to a file.
 :)
declare %ann:nondeterministic function file:is-file(
  $file as xs:string
) as xs:boolean external;

(:~
 : Moves a file or directory given a source and a destination paths/URIs.
 :
 : @param $source The path/URI of the file to move.
 : @param $destination The destination path/URI.
 : @return The empty sequence.
 : @error file:FOFL0001 If the
$source
 path does not exist.
 : @error file:FOFL0002 If
$source
 points to a directory and
 :
$destination
 points to an existing file.
 : @error file:FOFL0003 If
$destination
 does not exist and it's parent
 :    directory does not exist either.
 : @error file:FOFL9999 If any other error occurs.
 :)
declare %ann:sequential function file:move(
  $source as xs:string,
  $destination as xs:string
) as empty-sequence()
{
  file:copy($source, $destination);
  file:delete($source);
};

(:~
 : Reads the content of a file and returns a Base64 representation of the
 : content.
 :
 : @param $file The file to read.
 : @return The content of the file as Base64.
 : @error file:FOFL0001 If the
$source
 path does not exist.
 : @error file:FOFL0004 If
$source
 points to a directory.
 : @error file:FOFL9999 If any other error occurs.
 :)
declare %ann:nondeterministic function file:read-binary(
  $file as xs:string
) as xs:base64Binary external;

(:~
 : Reads the content of a file and returns a string representation of the
 : content.
 :
 : The operation is equivalent to calling:
 :
file:read-text($file, "UTF-8")
.
 :
 : @param $file The file to read.
 : @return The content of the file as string.
 : @error file:FOFL0001 If the
$source
 path does not exist.
 : @error file:FOFL0004 If
$source
 points to a directory.
 : @error file:FOFL9999 If any other error occurs.
 :)
declare %ann:nondeterministic function file:read-text(
  $file as xs:string
) as xs:string
{
  file:read-text($file, "UTF-8")
};

(:~
 : Reads the content of a file using the specified encoding and returns a
 : string representation of the content.
 :
 : In Zorba only the following encodings are currently supported: "UTF-8",
 : "UTF8". The encoding parameter is case insensitive.
 :
 : @param $file The file to read.
 : @param $encoding The encoding used when reading the file.
 : @return The content of the file as string.
 : @error file:FOFL0001 If the
$source
 path does not exist.
 : @error file:FOFL0004 If
$source
 points to a directory.
 : @error file:FOFL0006 If
$encoding
 is not supported.
 : @error file:FOFL9999 If any other error occurs.
 :)
declare %ann:nondeterministic function file:read-text(
  $file as xs:string,
  $encoding as xs:string
) as xs:string external;

(:~
 : Reads the content of a file and returns a sequence of strings representing
 : the lines in the content of the file.
 :
 : The operation is equivalent to calling:
 :
file:read-text-lines($file, "UTF-8")
.
 :
 : @param $file The file to read.
 : @return The content of the file as a sequence of strings.
 : @error file:FOFL0001 If the
$source
 path does not exist.
 : @error file:FOFL0004 If
$source
 points to a directory.
 : @error file:FOFL9999 If any other error occurs.
 :)
declare %ann:nondeterministic function file:read-text-lines(
  $file as xs:string
) as xs:string*
{
  file:read-text-lines($file, "UTF-8")
};

(:~
 : Reads the content of a file using the specified encoding and returns a
 : sequence of strings representing the lines in the content of the file.
 :
 : This implementation considers the LF (
) character as the line
 : separator. If a resulting line ends with the CR (
) character, this is
 : trimmed as well. This implementation will uniformly treat LF and CRLF as
 : line separators.
 :
 : In Zorba only the following encodings are currently supported: "UTF-8",
 : "UTF8". The encoding parameter is case insensitive.
 :
 : @param $file The file to read.
 : @param $encoding The encoding used when reading the file.
 : @return The content of the file as a sequence of strings.
 : @error file:FOFL0001 If the
$source
 path does not exist.
 : @error file:FOFL0004 If
$source
 points to a directory.
 : @error file:FOFL0006 If
$encoding
 is not supported.
 : @error file:FOFL9999 If any other error occurs.
 :)
declare %ann:nondeterministic function file:read-text-lines(
  $file as xs:string,
  $encoding as xs:string
) as xs:string*
{
  let $content := file:read-text($file, $encoding)
  return fn:tokenize($content, "\n")
};

(:~
 : This is an internal function that copies an entire source directory to an
 : destination directory. The caller to this function must make sure that both
 : the source and destination point to existing directories.
 :
 : @param $sourceDir The existing source directory.
 : @param $destinationDir The existing destination directory.
 : @return The empty sequence.
 :)
declare %private %ann:nondeterministic %ann:sequential function file:copy-directory(
  $sourceDir as xs:string,
  $destinationDir as xs:string
) as empty-sequence()
{
  let $name := file:base-name($sourceDir)
  let $destDir := fn:concat($destinationDir, file:directory-separator(), $name)
  return
    {
      file:create-directory($destDir);

      for $item in file:list($sourceDir)
      let $fullSrcPath := fn:concat($sourceDir, file:directory-separator(), $item)
      let $fullDestPath := fn:concat($destDir, file:directory-separator(), $item)
      return
        if (file:is-directory($fullSrcPath)) then
          file:copy-directory($fullSrcPath, $fullDestPath)
        else
          file:copy($fullSrcPath, $fullDestPath)
    }
};

(:~
 : Writes a sequence of items to a file. Before writing to the file, the items
 : are serialized according to the
$serializer-params
.
 :
 : The semantics of
$serializer-params
 is the same as for the
 :
$params
 parameter of the fn:serialize
 : function.
 :
 : @param $file The path/URI of the file to write the content to.
 : @param $content The content to be serialized to the file.
 : @param $serializer-params Parameter to control the serialization of the
 :        content.
 : @return The empty sequence.
 : @error file:FOFL0004 If
$file
 points to a directory.
 : @error file:FOFL9999 If any other error occurs.
 :)
declare %ann:sequential function file:write(
  $file as xs:string,
  $content as item()*,
  $serializer-params as element(output:serialization-parameters)?
) as empty-sequence()
{
  file:write-text($file, fn:serialize($content, $serializer-params))
};

(:~
 : Writes a sequence of Base64 items as binary to a file.
 :
 : The operation is equivalent to calling:
 :
file:write-binary($file, $content, fn:true())
.
 :
 : @param $file The path/URI of the file to write the content to.
 : @param $content The content to be serialized to the file.
 : @return The empty sequence.
 : @error file:FOFL0004 If
$file
 points to a directory.
 : @error file:FOFL9999 If any other error occurs.
 :)
declare %ann:sequential function file:write-binary(
  $file as xs:string,
  $content as xs:base64Binary*
) as empty-sequence() external;

(:~
 : Writes a sequence of Base64 items as binary to a file.
 :
 : @param $file The path/URI of the file to write the content to.
 : @param $content The content to be serialized to the file.
 : @return The empty sequence.
 : @error file:FOFL0004 If
$file
 points to a directory.
 : @error file:FOFL9999 If any other error occurs.
 :)
declare %ann:sequential function file:write-binary(
  $file as xs:string,
  $content as xs:base64Binary*
) as empty-sequence() external;

(:~
 : Writes a sequence of string items to a file.
 :
 : The operation is equivalent to calling:
 :
file:write-text($file, $content, fn:true())
.
 :
 : @param $file The path/URI of the file to write the content to.
 : @param $content The content to be serialized to the file.
 : @return The empty sequence.
 : @error file:FOFL0004 If
$file
 points to a directory.
 : @error file:FOFL9999 If any other error occurs.
 :)
declare %private %ann:sequential function file:write-text(
  $file as xs:string,
  $content as xs:string*
) as empty-sequence() external;

(:~
 : Lists the file system items in a certain directory.
 :
 : The operation is equivalent to calling:
 :
file:list($dir, fn:false())
.
 :
 : @param $dir The path/URI of the directory to retrieve the children from.
 : @return The sequence of names of the direct children.
 : @error file:FOFL0003 If
$dir
 does not point to an existing directory.
 : @error file:FOFL9999 If any other error occurs.
 :)
declare %ann:nondeterministic function file:list(
  $dir as xs:string
) as xs:string* external;

(:~
 : Lists the file system items in a certain directory. The order of the items
 : in the resulting sequence is not defined. The "." and ".." items are not
 : returned. The returned paths are relative to the provided
$path
.
 :
 : If
$recursive
 evaluates to
fn:true()
, the operation
 : will recurse in the subdirectories.
 :
 : @param $dir The path/URI to retrieve the children from.
 : @param $recursive A boolean flag indicating whether the operation should be
 :    performed recursively.
 : @return A sequence of relative paths.
 : @error file:FOFL0003 If
$dir
 does not point to an existing directory.
 : @error file:FOFL9999 If any other error occurs.
 :)
declare %ann:nondeterministic function file:list(
  $path as xs:string,
  $recursive as xs:boolean
) as xs:string*
{
  for $f in file:list($path)
  let $full := fn:concat($path, file:directory-separator(), $f)
  return (
    $f,
    if ($recursive and file:is-directory($full)) then
      for $child in file:list($full, $recursive)
      return fn:concat($f, file:directory-separator(), $child)
    else
      ()
  )
};

(:~
 : Lists all files matching the given pattern in a given directory.
 : The order of the items in the result is not defined.
 : The "." and ".." items are not considered for the match.
 : The file paths are relative to the provided $path.
 :
 : The pattern is a glob expression supporting:
 :

 :

*
 for matching any number of unknown characters

 :

?
 for matching one unknown character

 :

 :
 : @param $path The path/URI to retrieve the children from.
 : @param $recursive A boolean flag indicating whether the operation should be
 :    performed recursively.
 : @param $pattern The file name pattern.
 : @return A sequence of file names matching the pattern.
 : @error file:FOFL0003 If
$dir
 does not point to an existing directory.
 : @error file:FOFL9999 If any other error occurs.
 :)
declare %ann:nondeterministic function file:list(
  $path as xs:string,
  $recursive as xs:boolean,
  $pattern as xs:string
) as xs:string* {
  for $file in file:list($path, $recursive)
  let $name := fn:tokenize($file, fn:concat("\", file:directory-separator()))[fn:last()]
  return
    if (fn:matches($name, file:glob-to-regex($pattern))) then
      $file
    else
      ()
};

(:~
 : A helper function that performs a trivial (not complete) glob to regex
 : pattern translation.
 :
 : @param $pattern The glob pattern.
 : @return A regex pattern corresponding to the glob pattern provided.
 :)
declare function file:glob-to-regex(
  $pattern as xs:string
) {
  let $pattern := fn:replace($pattern, '(\.|\[|\]|\\|\/|\||\-|\^|\$|\?|\*|\+|\{|\}|\(|\))','\\$1')
  let $pattern := fn:replace($pattern, '\\\?', '.')
  let $pattern := fn:replace($pattern, '\\\*', '.*')
  return
    fn:concat("^", $pattern, "$")
};

(:~
 : Retrieves the timestamp of the last modification of the file system item
 : pointed by the path/URI.
 :
 : @param $path The file system item to read the last modification
 :    timestamp from.
 : @return The date and time of the last modification of the item.
 : @error file:FOFL0001 If the
$path
 does not exist.
 : @error file:FOFL9999 If any other error occurs.
 :)
declare %ann:nondeterministic function file:last-modified(
  $path as xs:string
) as xs:dateTime external;

(:~
 : Retrieves the size of a file.
 :
 : @param $file The file get the size.
 : @return An integer representing the size in bytes of the file.
 : @error file:FOFL0001 If the
$file
 does not exist.
 : @error file:FOFL0004 If the
$file
 points to a directory.
 : @error file:FOFL9999 If any other error occurs.
 :)
declare %ann:nondeterministic function file:size(
  $file as xs:string
) as xs:integer external;

(:~
 : This function returns the value of the operating system specific directory
 : separator. For example,
/
 on UNIX-based systems and
\

 : on Windows systems.
 :
 : @return The operating system specific directory separator.
 :)
declare function file:directory-separator() as xs:string external;

(:~
 : This function returns the value of the operating system specific path
 : separator. For example,
:
 on UNIX-based systems and
;

 : on Windows systems.
 :
 : @return The operating system specific path separator.
 :)
declare function file:path-separator() as xs:string external;

(:~
 : Transforms a relative path/URI into an absolute operating system path by
 : resolving it against the current working directory.
 :
 : No path existence check is made.
 :
 : @param $path The path/URI to transform.
 : @return The operating system file path.
 :)
declare function file:resolve-path(
  $path as xs:string
) as xs:string external;

(:~
 : Transforms a file system path into a URI with the file:// scheme. If the
 : path is relative, it is first resolved against the current working
 : directory.
 :
 : No path existence check is made.
 :
 : @param $path The path to transform.
 : @return The file URI corresponding to
path
.
 :)
declare function file:path-to-uri(
  $path as xs:string
) as xs:anyURI external;

(:~
 : Transforms a URI, an absolute path, or relative path to a native path on the
 : running platform.
 :
 : No path existence check is made.
 :
 : @param $path The uri or path to normalize.
 : @return The native path corresponding to
$path
.
 : @error file:FOFL9999 If an error occurs while trying to obtain the native path.
 :)
declare function file:path-to-native($path as xs:string) as xs:string external;

(:~
 : Returns the last component from the
$path
, deleting any
 : trailing directory-separator characters. If
$path
 consists
 : entirely directory-separator characters, the empty string is returned. If
 :
$path
 is the empty string, the string
"."
 is returned,
 : signifying the current directory.
 :
 : No path existence check is made.
 :
 : @param $path A file path/URI.
 : @return The base name of this file.
 :)
declare function file:base-name($path as xs:string) as xs:string
{
  let $delim := file:directory-separator()
  let $escapedDelim :=
    if ($delim eq "/") then
      $delim
    else
      fn:concat("\", $delim)
  let $normalized-file :=
    let $n := file:prepare-for-dirname-and-base-name($path)
    return if ($delim eq "\" and fn:matches($n, "^[a-zA-Z]:$")) then
      fn:concat($n, "\")
    else $n
  return
    if (fn:matches($path, fn:concat("^", $escapedDelim, "+$"))) then
      ""
    else if ($delim eq "\" and fn:matches($path, "^[a-zA-Z]:\\?$")) then
      ""
    else if ($path eq "") then
      "."
    else
      fn:replace($normalized-file, fn:concat("^.*", $escapedDelim), "")
};

(:~
 : Returns the last component from the
$path
, deleting any
 : trailing directory-separator characters and the
$suffix
. If path
 : consists entirely directory-separator characters, the empty string is
 : returned. If path is the empty string, the string
"."
 is
 : returned, signifying the current directory.
 :
 : No path existence check is made.
 :
 : The
$suffix
 can be used for example to eliminate file extensions.
 :
 : @param $path A file path/URI.
 : @param $suffix A suffix which should get deleted from the result.
 : @return The base-name of $path with a deleted $suffix.
 :)
declare function file:base-name($path as xs:string, $suffix as xs:string) as xs:string
{
  let $res := file:base-name($path)
  return
    if (fn:ends-with($res, $suffix) and $res ne ".") then
      fn:substring($res, 1, fn:string-length($suffix))
    else
      $res
};

(:~
 : This function is the converse of
file:base-name
. It returns a
 : string denoting the parent directory of the
$path
. Any trailing
 : directory-separator characters are not counted as part of the directory
 : name. If path is the empty string or contains no directory-separator string,
 :
"."
 is returned, signifying the current directory.
 :
 : No path existence check is made.
 :
 : @param $path The filename, of which the dirname should be get.
 : @return The name of the directory the file is in.
 :)
declare function file:dir-name($path as xs:string) as xs:string
{
  let $delim := file:directory-separator()
  let $escapedDelim :=
    if ($delim eq "/") then
      $delim
    else
      fn:concat("\", $delim)
  let $normalized-file := file:prepare-for-dirname-and-base-name($path)
  return
    if (fn:matches($path, fn:concat("^", $escapedDelim, "+$"))) then
      $delim
    else if ($normalized-file eq $delim) then
      $delim
    else if ($delim eq "\" and fn:matches($path, "^[a-zA-Z]:\\$")) then
      $path
    else if ($delim eq "\" and fn:matches($normalized-file, "^[a-zA-Z]:$")) then
      fn:concat($normalized-file, '\')
    else if ($path eq "") then
      "."
    else if (fn:matches($normalized-file, $escapedDelim)) then
      fn:replace($normalized-file, fn:concat("^(.*)", $escapedDelim, ".*"), "$1")
    else
      "."
};

(:~
 : This is a helper function used by dirname and base-name. This function takes a path as
 : input and normalizes it according to the rules states in dirname/base-name documentation
 : and normalizes it to a system specific path.
 :)
declare %private function file:prepare-for-dirname-and-base-name($path as xs:string) as xs:string
{
  let $delim := file:directory-separator()
  let $escapedDelim :=
    if ($delim eq "/") then
      $delim
    else
      fn:concat("\", $delim)
  let $normalize-path := file:path-to-native($path)
  let $normalized :=
    if ($normalize-path eq $delim) then
      $normalize-path
    else
      fn:replace($normalize-path, fn:concat($escapedDelim, "+$"), "")
  return $normalized
};

xquery version "3.0";

(:
 : Copyright 2006-2009 The FLWOR Foundation.
 :
 : Licensed under the Apache License, Version 2.0 (the "License");
 : you may not use this file except in compliance with the License.
 : You may obtain a copy of the License at
 :
 : http://www.apache.org/licenses/LICENSE-2.0
 :
 : Unless required by applicable law or agreed to in writing, software
 : distributed under the License is distributed on an "AS IS" BASIS,
 : WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 : See the License for the specific language governing permissions and
 : limitations under the License.
 :)

(:~
 : This module implements the file API EXPath specification available at http://expath.org/spec/file
 : @author Gabriel Petrovay, Matthias Brantner, Markus Pilman
 : @see http://expath.org/spec/file
 :)
module namespace file = "http://expath.org/ns/file";

import schema namespace output = "http://www.w3.org/2010/xslt-xquery-serialization";
declare namespace ann = "http://www.zorba-xquery.com/annotations";
declare namespace ver = "http://www.zorba-xquery.com/options/versioning";
declare option ver:module-version "2.0";

(:~
 : Appends a sequence of items to a file. If the file pointed by
$file

 : does not exist, a new file will be created. Before writing to the file, the items
 : are serialized according to the
$serializer-params
.
 :
 : The semantics of
$serializer-params
 is the same as for the
 :
$params
 parameter of the fn:serialize
 : function.
 :
 : @param $file The path/URI of the file to write the content to.
 : @param $content The content to be serialized to the file.
 : @param $serializer-params Parameter to control the serialization of the
 :    content.
 : @return The empty sequence.
 : @error file:FOFL0004 If
$file
 points to a directory.
 : @error file:FOFL9999 If any other error occurs.
 :)
declare %ann:sequential function file:append(
  $file as xs:string,
  $content as item()*,
  $serializer-params as element(output:serialization-parameters)?
) as empty-sequence()
{
  file:append-text(
    $file,
    fn:serialize($content, $serializer-params))
};

(:~
 : Appends a sequence of Base64 items as binary to a file. If the file pointed
 : by
$file
 does not exist, a new file will be created.
 :
 : @param $file The path/URI of the file to write the content to.
 : @param $content The content to be serialized to the file.
 : @return The empty sequence.
 : @error file:FOFL0004 If
$file
 points to a directory.
 : @error file:FOFL9999 If any other error occurs.
 :)
declare %ann:sequential function file:append-binary(
  $file as xs:string,
  $content as xs:base64Binary*
) as empty-sequence() external;

(:~
 : Appends a sequence of string items to a file.
 :
 : @param $file The path/URI of the file to write the content to.
 : @param $content The content to be serialized to the file.
 : @return The empty sequence.
 : @error file:FOFL0004 If
$file
 points to a directory.
 : @error file:FOFL9999 If any other error occurs.
 :)
declare %private %ann:sequential function file:append-text(
  $file as xs:string,
  $content as xs:string*
) as empty-sequence() external;

(:~
 : Copies a file or a directory given a source and a destination path/URI.
 :
 : @param $source The path/URI of the file or directory to copy.
 : @param $destination The destination path/URI.
 : @return The empty sequence.
 : @error file:FOFL0001 If the
$source
 path does not exist.
 : @error file:FOFL0002 If the computed destination points to a file system item
 :    with a different type than the
$source
.
 : @error file:FOFL0003 If
$destination
 does not exist and it's
 :    parent directory does not exist either.
 : @error file:FOFL9999 If any other error occurs.
 :)
declare %ann:nondeterministic %ann:sequential function file:copy(
  $source as xs:string,
  $destination as xs:string
) as empty-sequence()
{
  if (file:exists($source)) then
    if (file:is-directory($source)) then
      file:copy-directory-impl($source, $destination)
    else
      file:copy-file-impl($source, $destination)
  else
    fn:error(xs:QName("file:FOFL0001"), fn:concat("The source path does not exists: ", $source))
};

(:~
 : Copies a file given a source and a destination path/URI.
 :
 : @param $sourceFile The path/URI of the file to copy.
 : @param $destination The destination path/URI.
 : @return The empty sequence.
 : @error file:FOFL0001 If the
$source
 path does not exist.
 : @error file:FOFL0002 If the computed destination points to directory.
 : @error file:FOFL0003 If
$destination
 does not exist and it's
 :    parent directory does not exist either.
 : @error file:FOFL0004 If
$sourceFile
 points to a directory.
 : @error file:FOFL9999 If any other error occurs.
 :)
declare %private %ann:sequential function file:copy-file-impl(
  $sourceFile as xs:string,
  $destination as xs:string
) as empty-sequence() external;

(:~
 : Copies a source directory recursively to a destination path/URI.
 :
 : @param $sourceDir The path/URI of the directory to copy.
 : @param $destination The destination path/URI.
 : @return The empty sequence.
 : @error file:FOFL0001 If the
$source
 path does not exist.
 : @error file:FOFL0002 If
$destination
 points to an existing file.
 : @error file:FOFL0003 If
$destination
 does not exist and it's
 :    parent directory does not exist either.
 : @error file:FOFL9999 If any other error occurs.
 :)
declare %private %ann:nondeterministic %ann:sequential function file:copy-directory-impl(
  $sourceDir as xs:string,
  $destination as xs:string
) as empty-sequence()
{
  if (file:is-file($destination)) then
    fn:error(xs:QName("file:FOFL0002"), fn:concat("The specified destination path already exists: ", $destination))
  else if (fn:not(file:exists($destination))) then
    let $dirname := file:dir-name($destination)
    return
      if (fn:not(file:exists($dirname))) then
        fn:error(xs:QName("file:FOFL0003"), fn:concat("The destination directory does not exist: ", $dirname))
      else
        {
          file:create-directory($destination);
          file:copy-directory-content($sourceDir, $destination)
        }

  else
    let $basename := file:base-name($sourceDir)
    let $newdir := fn:concat($destination, file:directory-separator(), $basename)
    return
      {
        file:create-directory($newdir);
        file:copy-directory-content($sourceDir, $newdir)
      }
};

(:~
 : Copies the content of a given directory to an existing destination
 : directory.
 :
 : @param $sourceDir The path/URI of the directory to copy the content from.
 : @param $destination The destination directory path/URI.
 : @return The empty sequence.
 : @error file:FOFL0001 If the
$source
 path does not exist.
 : @error file:FOFL0003 If
$destination
 directory does not exist.
 : @error file:FOFL9999 If any other error occurs.
 :)
declare %private %ann:nondeterministic %ann:sequential function file:copy-directory-content(
  $sourceDir as xs:string,
  $destination as xs:string
) as empty-sequence()
{
  if (file:is-directory($destination)) then
    for $item in file:list($sourceDir)
    let $fullPath := fn:concat($sourceDir, file:directory-separator(), $item)
    return
      file:copy($fullPath, $destination)
  else
    fn:error(xs:QName("file:FOFL0003"), fn:concat("The specified destination directory does not exist: ", $destination))
};

(:~
 : Creates a directory.
 :
 : The operation is will create all the missing parent directories from the
 : given path.
 :
 : @param $dir The path/URI denoting the directory to be created.
 : @return The empty sequence.
 : @error file:FOFL0002 If the directory cannot be created because of an already
 :    existing file.
 : @error file:FOFL9999 If any other error occurs.
 :)
declare %ann:sequential function file:create-directory(
  $dir as xs:string
) as empty-sequence() external;

(:~
 : Deletes a file or a directory from the file system.
 :
 : If
$path
 points to a directory the directory will be deleted
 : recursively.
 :
 : @param $path The path/URI of the file or directory to delete.
 : @return The empty sequence.
 : @error file:FOFL0001 If the
$path
 path does not exist.
 : @error file:FOFL9999 If any other error occurs.
 :)
declare %ann:nondeterministic %ann:sequential function file:delete(
  $path as xs:string
) as empty-sequence()
{
  if (file:exists($path)) then
    if (file:is-directory($path)) then
      file:delete-directory-impl($path)
    else
      file:delete-file-impl($path)
  else
    fn:error(xs:QName("file:FOFL0001"), fn:concat("The path does not exists: ", $path))
};

(:~
 : Deletes a file from the file system.
 :
 : @param $file The path/URI of the file to delete.
 : @return The empty sequence.
 : @error file:FOFL0001 If the
$file
 path does not exist.
 : @error file:FOFL9999 If any other error occurs.
 :)
declare %private %ann:sequential function file:delete-file-impl(
  $file as xs:string
) as empty-sequence() external;

(:~
 : Deletes a directory from the file system.
 :
 : @param $dir The path/URI of the directory to delete.
 : @return The empty sequence.
 : @error file:FOFL0001 If the
$dir
 path does not exist.
 : @error file:FOFL0003 If
$dir
 does not point to a directory.
 : @error file:FOFL9999 If any other error occurs.
 :)
declare %private %ann:nondeterministic %ann:sequential function file:delete-directory-impl(
  $dir as xs:string
) as empty-sequence()
{
  for $item in file:list($dir)
  let $fullPath := fn:concat($dir, file:directory-separator(), $item)
  return
    if (file:is-directory($fullPath)) then
      file:delete-directory-impl($fullPath);
    else
      file:delete-file-impl($fullPath);

  file:delete-file-impl($dir)
};

(:~
 : Tests if a path/URI is already used in the file system.
 :
 : @param $path The path/URI to test for existence.
 : @return true if the path/URI points to an existing file system item.
 :)
declare %ann:nondeterministic function file:exists(
  $path as xs:string
) as xs:boolean external;

(:~
 : Tests if a path/URI points to a directory. On UNIX-based systems, the root
 : and the volume roots are considered directories.
 :
 : @param $dir The path/URI to test.
 : @return true if the path/URI points to a directory.
 :)
declare %ann:nondeterministic function file:is-directory(
  $dir as xs:string
) as xs:boolean external;

(:~
 : Tests if a path/URI points to a file.
 :
 : @param $dir The path/URI to test.
 : @return true if the path/URI points to a file.
 :)
declare %ann:nondeterministic function file:is-file(
  $file as xs:string
) as xs:boolean external;

(:~
 : Moves a file or directory given a source and a destination paths/URIs.
 :
 : @param $source The path/URI of the file to move.
 : @param $destination The destination path/URI.
 : @return The empty sequence.
 : @error file:FOFL0001 If the
$source
 path does not exist.
 : @error file:FOFL0002 If
$source
 points to a directory and
 :
$destination
 points to an existing file.
 : @error file:FOFL0003 If
$destination
 does not exist and it's parent
 :    directory does not exist either.
 : @error file:FOFL9999 If any other error occurs.
 :)
declare %ann:sequential function file:move(
  $source as xs:string,
  $destination as xs:string
) as empty-sequence()
{
  file:copy($source, $destination);
  file:delete($source);
};

(:~
 : Reads the content of a file and returns a Base64 representation of the
 : content.
 :
 : @param $file The file to read.
 : @return The content of the file as Base64.
 : @error file:FOFL0001 If the
$source
 path does not exist.
 : @error file:FOFL0004 If
$source
 points to a directory.
 : @error file:FOFL9999 If any other error occurs.
 :)
declare %ann:nondeterministic function file:read-binary(
  $file as xs:string
) as xs:base64Binary external;

(:~
 : Reads the content of a file and returns a string representation of the
 : content.
 :
 : The operation is equivalent to calling:
 :
file:read-text($file, "UTF-8")
.
 :
 : @param $file The file to read.
 : @return The content of the file as string.
 : @error file:FOFL0001 If the
$source
 path does not exist.
 : @error file:FOFL0004 If
$source
 points to a directory.
 : @error file:FOFL9999 If any other error occurs.
 :)
declare %ann:nondeterministic function file:read-text(
  $file as xs:string
) as xs:string
{
  file:read-text($file, "UTF-8")
};

(:~
 : Reads the content of a file using the specified encoding and returns a
 : string representation of the content.
 :
 : In Zorba only the following encodings are currently supported: "UTF-8",
 : "UTF8". The encoding parameter is case insensitive.
 :
 : @param $file The file to read.
 : @param $encoding The encoding used when reading the file.
 : @return The content of the file as string.
 : @error file:FOFL0001 If the
$source
 path does not exist.
 : @error file:FOFL0004 If
$source
 points to a directory.
 : @error file:FOFL0006 If
$encoding
 is not supported.
 : @error file:FOFL9999 If any other error occurs.
 :)
declare %ann:nondeterministic function file:read-text(
  $file as xs:string,
  $encoding as xs:string
) as xs:string external;

(:~
 : Reads the content of a file and returns a sequence of strings representing
 : the lines in the content of the file.
 :
 : The operation is equivalent to calling:
 :
file:read-text-lines($file, "UTF-8")
.
 :
 : @param $file The file to read.
 : @return The content of the file as a sequence of strings.
 : @error file:FOFL0001 If the
$source
 path does not exist.
 : @error file:FOFL0004 If
$source
 points to a directory.
 : @error file:FOFL9999 If any other error occurs.
 :)
declare %ann:nondeterministic function file:read-text-lines(
  $file as xs:string
) as xs:string*
{
  file:read-text-lines($file, "UTF-8")
};

(:~
 : Reads the content of a file using the specified encoding and returns a
 : sequence of strings representing the lines in the content of the file.
 :
 : This implementation considers the LF (
) character as the line
 : separator. If a resulting line ends with the CR (
) character, this is
 : trimmed as well. This implementation will uniformly treat LF and CRLF as
 : line separators.
 :
 : In Zorba only the following encodings are currently supported: "UTF-8",
 : "UTF8". The encoding parameter is case insensitive.
 :
 : @param $file The file to read.
 : @param $encoding The encoding used when reading the file.
 : @return The content of the file as a sequence of strings.
 : @error file:FOFL0001 If the
$source
 path does not exist.
 : @error file:FOFL0004 If
$source
 points to a directory.
 : @error file:FOFL0006 If
$encoding
 is not supported.
 : @error file:FOFL9999 If any other error occurs.
 :)
declare %ann:nondeterministic function file:read-text-lines(
  $file as xs:string,
  $encoding as xs:string
) as xs:string*
{
  let $content := file:read-text($file, $encoding)
  return fn:tokenize($content, "\n")
};

(:~
 : This is an internal function that copies an entire source directory to an
 : destination directory. The caller to this function must make sure that both
 : the source and destination point to existing directories.
 :
 : @param $sourceDir The existing source directory.
 : @param $destinationDir The existing destination directory.
 : @return The empty sequence.
 :)
declare %private %ann:nondeterministic %ann:sequential function file:copy-directory(
  $sourceDir as xs:string,
  $destinationDir as xs:string
) as empty-sequence()
{
  let $name := file:base-name($sourceDir)
  let $destDir := fn:concat($destinationDir, file:directory-separator(), $name)
  return
    {
      file:create-directory($destDir);

      for $item in file:list($sourceDir)
      let $fullSrcPath := fn:concat($sourceDir, file:directory-separator(), $item)
      let $fullDestPath := fn:concat($destDir, file:directory-separator(), $item)
      return
        if (file:is-directory($fullSrcPath)) then
          file:copy-directory($fullSrcPath, $fullDestPath)
        else
          file:copy($fullSrcPath, $fullDestPath)
    }
};

(:~
 : Writes a sequence of items to a file. Before writing to the file, the items
 : are serialized according to the
$serializer-params
.
 :
 : The semantics of
$serializer-params
 is the same as for the
 :
$params
 parameter of the fn:serialize
 : function.
 :
 : @param $file The path/URI of the file to write the content to.
 : @param $content The content to be serialized to the file.
 : @param $serializer-params Parameter to control the serialization of the
 :        content.
 : @return The empty sequence.
 : @error file:FOFL0004 If
$file
 points to a directory.
 : @error file:FOFL9999 If any other error occurs.
 :)
declare %ann:sequential function file:write(
  $file as xs:string,
  $content as item()*,
  $serializer-params as element(output:serialization-parameters)?
) as empty-sequence()
{
  file:write-text($file, fn:serialize($content, $serializer-params))
};

(:~
 : Writes a sequence of Base64 items as binary to a file.
 :
 : The operation is equivalent to calling:
 :
file:write-binary($file, $content, fn:true())
.
 :
 : @param $file The path/URI of the file to write the content to.
 : @param $content The content to be serialized to the file.
 : @return The empty sequence.
 : @error file:FOFL0004 If
$file
 points to a directory.
 : @error file:FOFL9999 If any other error occurs.
 :)
declare %ann:sequential function file:write-binary(
  $file as xs:string,
  $content as xs:base64Binary*
) as empty-sequence() external;

(:~
 : Writes a sequence of Base64 items as binary to a file.
 :
 : @param $file The path/URI of the file to write the content to.
 : @param $content The content to be serialized to the file.
 : @return The empty sequence.
 : @error file:FOFL0004 If
$file
 points to a directory.
 : @error file:FOFL9999 If any other error occurs.
 :)
declare %ann:sequential function file:write-binary(
  $file as xs:string,
  $content as xs:base64Binary*
) as empty-sequence() external;

(:~
 : Writes a sequence of string items to a file.
 :
 : The operation is equivalent to calling:
 :
file:write-text($file, $content, fn:true())
.
 :
 : @param $file The path/URI of the file to write the content to.
 : @param $content The content to be serialized to the file.
 : @return The empty sequence.
 : @error file:FOFL0004 If
$file
 points to a directory.
 : @error file:FOFL9999 If any other error occurs.
 :)
declare %private %ann:sequential function file:write-text(
  $file as xs:string,
  $content as xs:string*
) as empty-sequence() external;

(:~
 : Lists the file system items in a certain directory.
 :
 : The operation is equivalent to calling:
 :
file:list($dir, fn:false())
.
 :
 : @param $dir The path/URI of the directory to retrieve the children from.
 : @return The sequence of names of the direct children.
 : @error file:FOFL0003 If
$dir
 does not point to an existing directory.
 : @error file:FOFL9999 If any other error occurs.
 :)
declare %ann:nondeterministic function file:list(
  $dir as xs:string
) as xs:string* external;

(:~
 : Lists the file system items in a certain directory. The order of the items
 : in the resulting sequence is not defined. The "." and ".." items are not
 : returned. The returned paths are relative to the provided
$path
.
 :
 : If
$recursive
 evaluates to
fn:true()
, the operation
 : will recurse in the subdirectories.
 :
 : @param $dir The path/URI to retrieve the children from.
 : @param $recursive A boolean flag indicating whether the operation should be
 :    performed recursively.
 : @return A sequence of relative paths.
 : @error file:FOFL0003 If
$dir
 does not point to an existing directory.
 : @error file:FOFL9999 If any other error occurs.
 :)
declare %ann:nondeterministic function file:list(
  $path as xs:string,
  $recursive as xs:boolean
) as xs:string*
{
  for $f in file:list($path)
  let $full := fn:concat($path, file:directory-separator(), $f)
  return (
    $f,
    if ($recursive and file:is-directory($full)) then
      for $child in file:list($full, $recursive)
      return fn:concat($f, file:directory-separator(), $child)
    else
      ()
  )
};

(:~
 : Lists all files matching the given pattern in a given directory.
 : The order of the items in the result is not defined.
 : The "." and ".." items are not considered for the match.
 : The file paths are relative to the provided $path.
 :
 : The pattern is a glob expression supporting:
 :

 :

*
 for matching any number of unknown characters

 :

?
 for matching one unknown character

 :

 :
 : @param $path The path/URI to retrieve the children from.
 : @param $recursive A boolean flag indicating whether the operation should be
 :    performed recursively.
 : @param $pattern The file name pattern.
 : @return A sequence of file names matching the pattern.
 : @error file:FOFL0003 If
$dir
 does not point to an existing directory.
 : @error file:FOFL9999 If any other error occurs.
 :)
declare %ann:nondeterministic function file:list(
  $path as xs:string,
  $recursive as xs:boolean,
  $pattern as xs:string
) as xs:string* {
  for $file in file:list($path, $recursive)
  let $name := fn:tokenize($file, fn:concat("\", file:directory-separator()))[fn:last()]
  return
    if (fn:matches($name, file:glob-to-regex($pattern))) then
      $file
    else
      ()
};

(:~
 : A helper function that performs a trivial (not complete) glob to regex
 : pattern translation.
 :
 : @param $pattern The glob pattern.
 : @return A regex pattern corresponding to the glob pattern provided.
 :)
declare function file:glob-to-regex(
  $pattern as xs:string
) {
  let $pattern := fn:replace($pattern, '(\.|\[|\]|\\|\/|\||\-|\^|\$|\?|\*|\+|\{|\}|\(|\))','\\$1')
  let $pattern := fn:replace($pattern, '\\\?', '.')
  let $pattern := fn:replace($pattern, '\\\*', '.*')
  return
    fn:concat("^", $pattern, "$")
};

(:~
 : Retrieves the timestamp of the last modification of the file system item
 : pointed by the path/URI.
 :
 : @param $path The file system item to read the last modification
 :    timestamp from.
 : @return The date and time of the last modification of the item.
 : @error file:FOFL0001 If the
$path
 does not exist.
 : @error file:FOFL9999 If any other error occurs.
 :)
declare %ann:nondeterministic function file:last-modified(
  $path as xs:string
) as xs:dateTime external;

(:~
 : Retrieves the size of a file.
 :
 : @param $file The file get the size.
 : @return An integer representing the size in bytes of the file.
 : @error file:FOFL0001 If the
$file
 does not exist.
 : @error file:FOFL0004 If the
$file
 points to a directory.
 : @error file:FOFL9999 If any other error occurs.
 :)
declare %ann:nondeterministic function file:size(
  $file as xs:string
) as xs:integer external;

(:~
 : This function returns the value of the operating system specific directory
 : separator. For example,
/
 on UNIX-based systems and
\

 : on Windows systems.
 :
 : @return The operating system specific directory separator.
 :)
declare function file:directory-separator() as xs:string external;

(:~
 : This function returns the value of the operating system specific path
 : separator. For example,
:
 on UNIX-based systems and
;

 : on Windows systems.
 :
 : @return The operating system specific path separator.
 :)
declare function file:path-separator() as xs:string external;

(:~
 : Transforms a relative path/URI into an absolute operating system path by
 : resolving it against the current working directory.
 :
 : No path existence check is made.
 :
 : @param $path The path/URI to transform.
 : @return The operating system file path.
 :)
declare function file:resolve-path(
  $path as xs:string
) as xs:string external;

(:~
 : Transforms a file system path into a URI with the file:// scheme. If the
 : path is relative, it is first resolved against the current working
 : directory.
 :
 : No path existence check is made.
 :
 : @param $path The path to transform.
 : @return The file URI corresponding to
path
.
 :)
declare function file:path-to-uri(
  $path as xs:string
) as xs:anyURI external;

(:~
 : Transforms a URI, an absolute path, or relative path to a native path on the
 : running platform.
 :
 : No path existence check is made.
 :
 : @param $path The uri or path to normalize.
 : @return The native path corresponding to
$path
.
 : @error file:FOFL9999 If an error occurs while trying to obtain the native path.
 :)
declare function file:path-to-native($path as xs:string) as xs:string external;

(:~
 : Returns the last component from the
$path
, deleting any
 : trailing directory-separator characters. If
$path
 consists
 : entirely directory-separator characters, the empty string is returned. If
 :
$path
 is the empty string, the string
"."
 is returned,
 : signifying the current directory.
 :
 : No path existence check is made.
 :
 : @param $path A file path/URI.
 : @return The base name of this file.
 :)
declare function file:base-name($path as xs:string) as xs:string
{
  let $delim := file:directory-separator()
  let $normalized-file :=
    let $n := file:prepare-for-dirname-and-base-name($path)
		return if ($delim eq "\" and fn:matches($n, "^[a-zA-Z]:$")) then
			concat($n, "\")
		else $n
  return
    if (matches($path, concat("^\", $delim, "+$"))) then
      ""
    else if (file:directory-separator() eq '\' and matches($path, "^[a-zA-Z]:\\?$")) then
      ""
    else if ($path eq "") then
      "."
    else
      replace($normalized-file, concat("^.*\", $delim), '')
};

(:~
 : Returns the last component from the
$path
, deleting any
 : trailing directory-separator characters and the
$suffix
. If path
 : consists entirely directory-separator characters, the empty string is
 : returned. If path is the empty string, the string
"."
 is
 : returned, signifying the current directory.
 :
 : No path existence check is made.
 :
 : The
$suffix
 can be used for example to eliminate file extensions.
 :
 : @param $path A file path/URI.
 : @param $suffix A suffix which should get deleted from the result.
 : @return The base-name of $path with a deleted $suffix.
 :)
declare function file:base-name($path as xs:string, $suffix as xs:string) as xs:string
{
  let $res := file:base-name($path)
  return
    if (fn:ends-with($res, $suffix) and $res ne ".") then
      fn:substring($res, 1, fn:string-length($suffix))
    else
      $res
};

(:~
 : This function is the converse of
file:base-name
. It returns a
 : string denoting the parent directory of the
$path
. Any trailing
 : directory-separator characters are not counted as part of the directory
 : name. If path is the empty string or contains no directory-separator string,
 :
"."
 is returned, signifying the current directory.
 :
 : No path existence check is made.
 :
 : @param $path The filename, of which the dirname should be get.
 : @return The name of the directory the file is in.
 :)
declare function file:dir-name($path as xs:string) as xs:string
{
  let $delim := file:directory-separator()
  let $normalized-file := file:prepare-for-dirname-and-base-name($path)
  return
    if (fn:matches($path, concat("^\", $delim, "+$"))) then
      $delim
    else if ($normalized-file eq $delim) then
      $delim
    else if (file:directory-separator() eq '\' and fn:matches($path, "^[a-zA-Z]:\\$")) then
      $path
    else if (file:directory-separator() eq '\' and fn:matches($normalized-file, "^[a-zA-Z]:$")) then
      fn:concat($normalized-file, '\')
    else if ($path eq "") then
      "."
    else if (fn:matches($normalized-file, fn:concat("\", $delim))) then
      fn:replace($normalized-file, fn:concat('^(.*)\', $delim,'.*'), '$1')
    else
      "."
};

(:~
 : This is a helper function used by dirname and base-name. This function takes a path as
 : input and normalizes it according to the rules states in dirname/base-name documentation
 : and normalizes it to a system specific path.
 :)
declare %private function file:prepare-for-dirname-and-base-name($path as xs:string) as xs:string
{
  let $delim := file:directory-separator()
  let $normalize-path := file:path-to-native($path)
  let $normalized :=
    if ($normalize-path eq $delim) then
      $normalize-path
    else
      fn:replace($normalize-path, fn:concat("\", $delim, '+$'), '')
  return $normalized
};


use numberserver to avoid dclp/hgv doubles

declare namespace tei = "http://www.tei-c.org/ns/1.0";
declare namespace rdf = "http://www.w3.org/1999/02/22-rdf-syntax-ns#";
declare namespace hgv = "HGV";
declare option saxon:output "method=xml";
declare option saxon:output "indent=yes";
declare variable $idpData external;

(: java -Xms512m -Xmx1536m net.sf.saxon.Query -q:idno.xql idpData=.../idp.data > idno.xml :)

<list>{
  (for $doc in collection(concat($idpData, '/HGV_meta_EpiDoc?select=*.xml;recurse=yes'))

    let $hgv := string($doc//tei:publicationStmt/tei:idno[@type = 'filename'])
    let $tm  := string($doc//tei:publicationStmt/tei:idno[@type = 'TM'])
    let $ddb := string($doc//tei:publicationStmt/tei:idno[@type = 'ddb-hybrid'])

    let $dclpFile := concat($idpData, '/DCLP/', ceiling(number($tm) div 1000), '/', $tm, '.xml')
    let $dclpEpiDoc := if(doc-available($dclpFile))then(doc($dclpFile))else()
    let $dclp := if($dclpEpiDoc)then(string($dclpEpiDoc//tei:publicationStmt/tei:idno[@type = 'dclp-hybrid']))else()

    return <item>
    <idno type="hgv">{data($hgv)}</idno>
    <idno type="tm">{data($tm)}</idno>
    <idno type="ddb">{data($ddb)}</idno>
    {if($dclp)then(
      <idno type="dclp">{data($dclp)}</idno>
    )else()}
    </item>
  ,
  for $doc in collection(concat($idpData, '/DCLP?select=*.xml;recurse=yes'))[.//tei:div[@type = 'edition'][@xml:lang = ('grc', 'la', 'egy-Egyd', 'cop', 'ara')]]

    let $tm   := $doc/tei:TEI/tei:teiHeader/tei:fileDesc/tei:publicationStmt/tei:idno[@type = 'TM']
    let $dclp := $doc/tei:TEI/tei:teiHeader/tei:fileDesc/tei:publicationStmt/tei:idno[@type = 'dclp-hybrid']
    let $dclpRdf := doc(concat('http://papyri.info/dclp/', $tm, '/rdf')) (: cl: dieser Zugriff kostet ca. eine halbe Stunde :)

    return if($dclpRdf//rdf:Description[starts-with(@rdf:about, 'http://papyri.info/hgv')])then(<item><idno type="tm">{data($tm)}</idno><idno type="dclp">{data($dclp)}</idno></item>)else()
    )
}</list>

declare namespace tei = "http://www.tei-c.org/ns/1.0";
declare namespace hgv = "HGV";
declare option saxon:output "method=xml";
declare option saxon:output "indent=yes";
declare variable $idpData external;

(: java -Xms512m -Xmx1536m net.sf.saxon.Query -q:idno.xql idpData=.../idp.data > idno.xml :)

<list>{
  (for $doc in collection(concat($idpData, '/HGV_meta_EpiDoc?select=*.xml;recurse=yes'))

    let $hgv := string($doc//tei:publicationStmt/tei:idno[@type = 'filename'])
    let $tm  := string($doc//tei:publicationStmt/tei:idno[@type = 'TM'])
    let $ddb := string($doc//tei:publicationStmt/tei:idno[@type = 'ddb-hybrid'])

    let $dclpFile := concat($idpData, '/DCLP/', ceiling(number($tm) div 1000), '/', $tm, '.xml')
    let $dclpEpiDoc := if(doc-available($dclpFile))then(doc($dclpFile))else()
    let $dclp := if($dclpEpiDoc)then(string($dclpEpiDoc//tei:publicationStmt/tei:idno[@type = 'dclp-hybrid']))else()

    return <item>
    <idno type="hgv">{data($hgv)}</idno>
    <idno type="tm">{data($tm)}</idno>
    <idno type="ddb">{data($ddb)}</idno>
    {if($dclp)then(
      <idno type="dclp">{data($dclp)}</idno>
    )else()}
    </item>
  ,
  for $doc in collection(concat($idpData, '/DCLP?select=*.xml;recurse=yes'))[.//tei:div[@type = 'edition'][@xml:lang = ('grc', 'la', 'egy-Egyd', 'cop', 'ara')]]

    let $tm   := $doc/tei:TEI/tei:teiHeader/tei:fileDesc/tei:publicationStmt/tei:idno[@type = 'TM']
    let $dclp := $doc/tei:TEI/tei:teiHeader/tei:fileDesc/tei:publicationStmt/tei:idno[@type = 'dclp-hybrid']

    return <item><idno type="tm">{data($tm)}</idno><idno type="dclp">{data($dclp)}</idno></item>
    )
}</list>


fixed moduleDocumentation test to not report errors if parameters in the fn module are not documented

import module namespace file = "http://www.zorba-xquery.com/modules/file";
import module namespace xqd = "http://www.zorba-xquery.com/modules/xqdoc";

import schema namespace xqdoc = "http://www.xqdoc.org/1.0" at "xqdoc-1.0.xsd";

declare copy-namespaces preserve, inherit;

(:~
 : This variable contains the modules directory path in the
 : source directory
 :)
declare variable $modulesPath as xs:string external;

(:~
 : This function generates the XQDoc XML for all the modules found in
 : $modulesPath : and write the resulting XML documents in $targetPath.
 : The hierarchy is preserved.
 :
 : @param $modulePath where to search for modules recursively.
:)
declare sequential function local:testXQDoc($modulesPath as xs:string) {
    for $file in file:files($modulesPath)
    let $filePath := concat($modulesPath, "/", $file)
    return
        if (file:is-directory($filePath))
        then
            local:testXQDoc($filePath)
        else if (matches($file, "\.xq$")) then (
            let $xqdoc := xqd:xqdoc(file:path-to-uri($filePath))/self::xqdoc:xqdoc
            return (
                local:test-functions($xqdoc),
                local:test-variables($xqdoc)
            )
        )
        else ()
};

declare function local:test-functions(
  $xqdoc as element(xqdoc:xqdoc)
)as xs:string* {
    let $module := $xqdoc/xqdoc:module
    for $function in $xqdoc/xqdoc:functions/xqdoc:function
    return local:test-function($module, $function)
};

declare function local:test-function(
  $module as element(xqdoc:module),
  $function as element(xqdoc:function)
) as xs:string* {
    let $signature := $function/xqdoc:signature
    let $paramCount := count(tokenize($signature, "\$")) - 1
    let $params := $function/xqdoc:comment/xqdoc:param
    let $docParamCount := count($params)
    let $missing := $paramCount - $docParamCount
    let $hasDescr := exists($function/xqdoc:comment/xqdoc:description)
    let $hasReturn := exists($function/xqdoc:comment/xqdoc:return)
    return (
        (: Test for function description :)
        if (not($hasDescr) and not($module/xqdoc:uri eq "http://www.w3.org/2005/xpath-functions")) then
            concat("ERROR: Missing function description
    Module: ", $module/xqdoc:uri, "
    Function: ", $function/xqdoc:name, "
    Arity: ", $paramCount)
        else
            (),
        (: Test for documented parameters :)
        if ($docParamCount ne $paramCount and not($module/xqdoc:uri eq "http://www.w3.org/2005/xpath-functions")) then
            concat("ERROR: ", $missing, " parameter(s) not documented
    Module: ", $module/xqdoc:uri, "
    Function: ", $function/xqdoc:name, "
    Arity: ", $paramCount)
        else
            (),
        (: Test for documented return value :)
        if (not($hasReturn) and not($module/xqdoc:uri eq "http://www.w3.org/2005/xpath-functions")) then
            concat("ERROR: Return value not documented;
    Module: ", $module/xqdoc:uri, "
    Function: ", $function/xqdoc:name, "
    Arity: ", $paramCount)
        else
            ()
    )
};

declare function local:test-variables(
  $xqdoc as element(xqdoc:xqdoc)
) as xs:string* {
    let $module := $xqdoc/xqdoc:module
    for $variable in $xqdoc/xqdoc:variables/xqdoc:variable
    return local:test-variable($module, $variable)
};

declare function local:test-variable(
  $module as element(xqdoc:module),
  $variable as element(xqdoc:variable)
) as xs:string* {
    let $hasDescr := exists($variable/xqdoc:comment/xqdoc:description)
    return
        (: Test for variable description :)
        if (not($hasDescr)) then
            concat("ERROR: Missing function description
    Module: ", $module/xqdoc:uri, "
    Variable: ", $variable/xqdoc:name)
        else
            ()
};

let $errors := local:testXQDoc($modulesPath)
return
    if (exists($errors)) then (
        concat("
------------------------------------------------
ERROR COUNT: ", count($errors), "
------------------------------------------------
"),
        for $error in $errors
        return
            concat("
", $error),
        concat("
------------------------------------------------
ERROR COUNT: ", count($errors), "
------------------------------------------------
")
    )
    else "CONGRATULATIONS! You've got a Schnitzel!"

import module namespace file = "http://www.zorba-xquery.com/modules/file";
import module namespace xqd = "http://www.zorba-xquery.com/modules/xqdoc";

import schema namespace xqdoc = "http://www.xqdoc.org/1.0" at "xqdoc-1.0.xsd";

declare copy-namespaces preserve, inherit;

(:~
 : This variable contains the modules directory path in the
 : source directory
 :)
declare variable $modulesPath as xs:string external;

(:~
 : This function generates the XQDoc XML for all the modules found in
 : $modulesPath : and write the resulting XML documents in $targetPath.
 : The hierarchy is preserved.
 :
 : @param $modulePath where to search for modules recursively.
:)
declare sequential function local:testXQDoc($modulesPath as xs:string) {
    for $file in file:files($modulesPath)
    let $filePath := concat($modulesPath, "/", $file)
    return
        if (file:is-directory($filePath))
        then
            local:testXQDoc($filePath)
        else if (matches($file, "\.xq$")) then (
            let $xqdoc := xqd:xqdoc(file:path-to-uri($filePath))/self::xqdoc:xqdoc
            return (
                local:test-functions($xqdoc),
                local:test-variables($xqdoc)
            )
        )
        else ()
};

declare function local:test-functions(
  $xqdoc as element(xqdoc:xqdoc)
)as xs:string* {
    let $module := $xqdoc/xqdoc:module
    for $function in $xqdoc/xqdoc:functions/xqdoc:function
    return local:test-function($module, $function)
};

declare function local:test-function(
  $module as element(xqdoc:module),
  $function as element(xqdoc:function)
) as xs:string* {
    let $signature := $function/xqdoc:signature
    let $paramCount := count(tokenize($signature, "\$")) - 1
    let $params := $function/xqdoc:comment/xqdoc:param
    let $docParamCount := count($params)
    let $missing := $paramCount - $docParamCount
    let $hasDescr := exists($function/xqdoc:comment/xqdoc:description)
    let $hasReturn := exists($function/xqdoc:comment/xqdoc:return)
    return (
        (: Test for function description :)
        if (not($hasDescr) and not($module/xqdoc:uri eq "http://www.w3.org/2005/xpath-functions")) then
            concat("ERROR: Missing function description
    Module: ", $module/xqdoc:uri, "
    Function: ", $function/xqdoc:name, "
    Arity: ", $paramCount)
        else
            (),
        (: Test for documented parameters :)
        if ($docParamCount ne $paramCount) then
            concat("ERROR: ", $missing, " parameter(s) not documented
    Module: ", $module/xqdoc:uri, "
    Function: ", $function/xqdoc:name, "
    Arity: ", $paramCount)
        else
            (),
        (: Test for documented return value :)
        if (not($hasReturn) and not($module/xqdoc:uri eq "http://www.w3.org/2005/xpath-functions")) then
            concat("ERROR: Return value not documented;
    Module: ", $module/xqdoc:uri, "
    Function: ", $function/xqdoc:name, "
    Arity: ", $paramCount)
        else
            ()
    )
};

declare function local:test-variables(
  $xqdoc as element(xqdoc:xqdoc)
) as xs:string* {
    let $module := $xqdoc/xqdoc:module
    for $variable in $xqdoc/xqdoc:variables/xqdoc:variable
    return local:test-variable($module, $variable)
};

declare function local:test-variable(
  $module as element(xqdoc:module),
  $variable as element(xqdoc:variable)
) as xs:string* {
    let $hasDescr := exists($variable/xqdoc:comment/xqdoc:description)
    return
        (: Test for variable description :)
        if (not($hasDescr)) then
            concat("ERROR: Missing function description
    Module: ", $module/xqdoc:uri, "
    Variable: ", $variable/xqdoc:name)
        else
            ()
};

let $errors := local:testXQDoc($modulesPath)
return
    if (exists($errors)) then (
        concat("
------------------------------------------------
ERROR COUNT: ", count($errors), "
------------------------------------------------
"),
        for $error in $errors
        return
            concat("
", $error),
        concat("
------------------------------------------------
ERROR COUNT: ", count($errors), "
------------------------------------------------
")
    )
    else "CONGRATULATIONS! You've got a Schnitzel!"


All tests pass

All tests pass

xquery version "3.0";

(:~
 : Tests for μ-templates
 :)
module namespace test = 'http://xokomola.com/xquery/origami/μ/tests';

import module namespace μ = 'http://xokomola.com/xquery/origami/μ' at '../mu.xqm';

declare namespace h = 'http://www.w3.org/1999/xhtml';

declare %unit:test function test:xml()
{

    (:~
     : A string becomes a text node.
     :)
    unit:assert-equals(
        μ:xml('a'),
        text { 'a' }
    ),

    unit:assert-equals(
        μ:xml(('a','b','c')),
        (text { 'a' }, text { 'b'}, text { 'c' })
    ),

    (:~
     : A one item array creates an empty element without attributes.
     :)
    unit:assert-equals(
        μ:xml(['a']),

    ),

    (:~
     : A two item array creates an element with child nodes.
     :)
    unit:assert-equals(
        μ:xml(['a','hello']),
        hello
    ),

    unit:assert-equals(
        μ:xml(['a','hello', 'world']),
        helloworld
    ),

    (:~
     : A two item array with the second item being a map returns
     : an empty element with attributes.
     :)
    unit:assert-equals(
        μ:xml(['a',map { 'x': 10, 'b': 'y' }]),

    ),

    (:~
     : Or, without attributes if the map is empty.
     :)
    unit:assert-equals(
        μ:xml(['a',map { }]),

    ),

    (:~
     : A three item array returns an element with attributes
     : and child nodes.
     :)
    unit:assert-equals(
        μ:xml(['a',map { 'x': 10, 'b': 'y' }, 'hello']),
        hello
    ),

    (:~
     : Or without attributes.
     :)
    unit:assert-equals(
        μ:xml(['a',map { }, 'hello']),
        hello
    ),

    (:~
     : Or without child nodes.
     :)
    unit:assert-equals(
        μ:xml(['a',map { 'x': 10, 'b': 'y' }, ()]),

    ),

    (:~
     : Or an empty element.
     :)
    unit:assert-equals(
        μ:xml(['a',map { }, ()]),

    ),

    (:~
     : If an item is already an XML node than it is passed
     : unmodified.
     :)
    unit:assert-equals(
        μ:xml(),

    ),

    (:~
     : Element items may be nested.
     :)
    unit:assert-equals(
        μ:xml(['a', (['b'], ['c'])]),

            <c/>

    ),

    unit:assert-equals(
        μ:xml(['a', ['b', ['c']]]),

                <c/>

    ),

    unit:assert-equals(
        μ:xml(['a', ('b','c')]),
        bc
    ),

    unit:assert-equals(
        μ:xml(['a', ('b','c')]),
        { text { 'b' }, text { 'c' }}
    ),

    unit:assert-equals(
        μ:xml(['a', 'b', 'c']),
        bc
    ),

    unit:assert-equals(
        μ:xml(['a', (map {'x': 1}, (map {'y': 2 }, 'b', 'c'))]),
        bc
    ),

    (: with naughty attribute/map values :)
    unit:assert-equals(
        μ:xml(['a', (map {'x': 1}, (map {'y': (2,3) }, 'b', 'c'))]),
        bc
    ),

    (:~
     : Atomic values will be converted into text nodes.
     :)
    unit:assert-equals(
        μ:xml(['a', (10,'c')]),
        10c
    ),

    (:~
     : Mixed content.
     :)
    unit:assert-equals(
        μ:xml(['a', ('foo', ['b', 'bar', ['c'], 'baz'])]),
        foobar<c/>baz
    )

};

declare %unit:test function test:json()
{
    unit:assert-equals(
        parse-json(μ:json(['a'])),
        ['a']
    ),

    unit:assert-equals(
        parse-json(μ:json(['a', ['b']])),
        ['a', ['b']]
    ),

    unit:assert-equals(
        parse-json(μ:json(['a', map { 'x': 1 }])),
        ['a', map { 'x': 1 }]
    ),

    unit:assert-equals(
        parse-json(μ:json(['a', map { 'x': 1 }, 'foo'])),
        ['a', map { 'x': 1 }, 'foo']
    ),

    unit:assert-equals(
        parse-json(μ:json(['a', map { 'x': 1 }, 'foo', 'bar'])),
        ['a', map { 'x': 1 }, 'foo', 'bar']
    ),

    unit:assert-equals(
        parse-json(μ:json(['a', map { 'x': 1 }, 'foo', ['b', 'bar'], 'baz'])),
        ['a', map { 'x': 1 }, 'foo', ['b', 'bar'], 'baz']
    ),

    unit:assert-equals(
        parse-json(μ:json(['a', map { 'x': 1 }, ('foo', ['b', 'bar'], 'baz')])),
        ['a', map { 'x': 1 }, 'foo', ['b', 'bar'], 'baz']
    ),

    unit:assert-equals(
        parse-json(μ:json(['a', map { 'x': 1 }, ('foo', (['b', 'bar'], 'baz'))])),
        ['a', map { 'x': 1 }, 'foo', ['b', 'bar'], 'baz']
    ),

    (: nodes will be converted to μ-nodes before serializing to JSON :)
    unit:assert-equals(
        parse-json(μ:json(['a', ])),
        ['a', ['b']]
    ),

    (: attribute nodes become string map entry values :)
    unit:assert-equals(
        parse-json(μ:json(['a', <c y="1">foo</c>, '!'])),
        ['a', ['b', ['c', map { 'y': '1' }, 'foo']], '!']
    )

};

declare %unit:test function test:do-xml()
{

    (:~
     : This is the simplest way to build a list.
     :)
    unit:assert-equals(
        μ:xml(['ul',
                for $i in 1 to 3
                return ['li', concat('item ', $i)] ]),

item 1

item 2

item 3

    ),

    unit:assert-equals(
        μ:xml-template(['ul',
            function($x) {
                for $i in 1 to $x
                return ['li', concat('item ', $i)]
            }])(3),

item 1

item 2

item 3

    ),

    (:~
     : The function may produce XML nodes. This is identical
     : to the above.
     :)
    unit:assert-equals(
        μ:xml-template(['ul',
            function($x) {
                for $i in 1 to $x
                return element li { concat('item ', $i) }
            }
        ])(3),

item 1

item 2

item 3

    ),

    (:~
     : Produce a table.
     :)
    unit:assert-equals(
        μ:xml-template(['table',
            function($r,$c) {
                for $i in 1 to $r
                return
                    ['tr',
                        function($r,$c) {
                            for $j in 1 to $c
                            return
                                ['td', concat('item ',$i,',',$j)]
                        }]
            }
        ])((3,2)),

              item 1,1
              item 1,2

              item 2,1
              item 2,2

              item 3,1
              item 3,2

    )
};

declare %unit:test function test:mu()
{

    unit:assert-equals(
        μ:mu(<x/>),
        ['x']),

    unit:assert-equals(
        μ:mu((<x/>, <y/>)),
        (['x'], ['y'])),

    unit:assert-equals(
        μ:mu(<x>hello</x>),
        ['x', 'hello']),

    unit:assert-equals(
        μ:mu(<x><y/></x>),
        ['x', ['y']]),

    unit:assert-equals(
        μ:mu(<x a="10" b="y"/>),
        ['x', map { 'a': '10', 'b': 'y' }]),

    unit:assert-equals(
        μ:mu(<x a="10" b="y">hello</x>),
        ['x', map { 'a': '10', 'b': 'y' }, 'hello']),

    unit:assert-equals(
        μ:mu(<x a="10" b="y">hello world</x>),
        ['x', map { 'a': '10', 'b': 'y' }, 'hello ', ['b', 'world']]),

    unit:assert-equals(
        μ:mu(<x>world</x>),
        ['x', 'world'])

};

declare %unit:test function test:xhtml()
{

    (:~
     : EXPERIMENTAL:
     : This only works for namespaces that are also declared inside
     : the library module. It cannot be changed unilaterally by the user.
     :)
    unit:assert-equals(
        μ:xml(['h:html']),
        <h:html/>
    ),

    unit:assert-equals(
        μ:xml(['h:html', ['x']]),
        <h:html><x/></h:html>
    ),

    unit:assert-equals(
        μ:mu(<h:html><x/></h:html>),
        ['h:html', ['x']]
    )

};

xquery version "3.0";

(:~
 : Tests for μ-templates
 :)
module namespace test = 'http://xokomola.com/xquery/origami/μ/tests';

import module namespace μ = 'http://xokomola.com/xquery/origami/μ' at '../mu.xqm';

declare namespace h = 'http://www.w3.org/1999/xhtml';

declare %unit:test function test:xml()
{

    (:~
     : A string becomes a text node.
     :)
    unit:assert-equals(
        μ:xml('a'),
        text { 'a' }
    ),

    unit:assert-equals(
        μ:xml(('a','b','c')),
        (text { 'a' }, text { 'b'}, text { 'c' })
    )
(:
    (:~
     : A one item array creates an empty element without attributes.
     :)
    unit:assert-equals(
        μ:xml(['a']),

    ),

    (:~
     : A two item array creates an element with child nodes.
     :)
    unit:assert-equals(
        μ:xml(['a','hello']),
        hello
    ),

    unit:assert-equals(
        μ:xml(['a','hello', 'world']),
        helloworld
    ),

    (:~
     : A two item array with the second item being a map returns
     : an empty element with attributes.
     :)
    unit:assert-equals(
        μ:xml(['a',map { 'x': 10, 'b': 'y' }]),

    ),

    (:~
     : Or, without attributes if the map is empty.
     :)
    unit:assert-equals(
        μ:xml(['a',map { }]),

    ),

    (:~
     : A three item array returns an element with attributes
     : and child nodes.
     :)
    unit:assert-equals(
        μ:xml(['a',map { 'x': 10, 'b': 'y' }, 'hello']),
        hello
    ),

    (:~
     : Or without attributes.
     :)
    unit:assert-equals(
        μ:xml(['a',map { }, 'hello']),
        hello
    ),

    (:~
     : Or without child nodes.
     :)
    unit:assert-equals(
        μ:xml(['a',map { 'x': 10, 'b': 'y' }, ()]),

    ),

    (:~
     : Or an empty element.
     :)
    unit:assert-equals(
        μ:xml(['a',map { }, ()]),

    ),

    (:~
     : If an item is already an XML node than it is passed
     : unmodified.
     :)
    unit:assert-equals(
        μ:xml(),

    ),

    (:~
     : Element items may be nested.
     :)
    unit:assert-equals(
        μ:xml(['a', (['b'], ['c'])]),

            <c/>

    ),

    unit:assert-equals(
        μ:xml(['a', ['b', ['c']]]),

                <c/>

    ),

    unit:assert-equals(
        μ:xml(['a', ('b','c')]),
        bc
    ),

    unit:assert-equals(
        μ:xml(['a', ('b','c')]),
        { text { 'b' }, text { 'c' }}
    ),

    unit:assert-equals(
        μ:xml(['a', 'b', 'c']),
        bc
    ),

    unit:assert-equals(
        μ:xml(['a', (map {'x': 1}, (map {'y': 2 }, 'b', 'c'))]),
        bc
    ),

    (: with naughty attribute/map values :)
    unit:assert-equals(
        μ:xml(['a', (map {'x': 1}, (map {'y': (2,3) }, 'b', 'c'))]),
        bc
    ),

    unit:assert-equals(
        μ:xml(['a', (map {'x': 1}, (map {'y': [2,[3]] }, 'b', 'c'))]),
        bc
    ),

    (:~
     : Atomic values will be converted into text nodes.
     :)
    unit:assert-equals(
        μ:xml(['a', (10,'c')]),
        10c
    ),

    (:~
     : Mixed content.
     :)
    unit:assert-equals(
        μ:xml(['a', ('foo', ['b', 'bar', ['c'], 'baz'])]),
        foobar<c/>baz
    )
:)
};

declare %unit:test function test:json()
{
    unit:assert-equals(
        parse-json(μ:json(['a'])),
        ['a']
    ),

    unit:assert-equals(
        parse-json(μ:json(['a', ['b']])),
        ['a', ['b']]
    ),

    unit:assert-equals(
        parse-json(μ:json(['a', map { 'x': 1 }])),
        ['a', map { 'x': 1 }]
    ),

    unit:assert-equals(
        parse-json(μ:json(['a', map { 'x': 1 }, 'foo'])),
        ['a', map { 'x': 1 }, 'foo']
    ),

    unit:assert-equals(
        parse-json(μ:json(['a', map { 'x': 1 }, 'foo', 'bar'])),
        ['a', map { 'x': 1 }, 'foo', 'bar']
    ),

    unit:assert-equals(
        parse-json(μ:json(['a', map { 'x': 1 }, 'foo', ['b', 'bar'], 'baz'])),
        ['a', map { 'x': 1 }, 'foo', ['b', 'bar'], 'baz']
    ),

    unit:assert-equals(
        parse-json(μ:json(['a', map { 'x': 1 }, ('foo', ['b', 'bar'], 'baz')])),
        ['a', map { 'x': 1 }, 'foo', ['b', 'bar'], 'baz']
    ),

    unit:assert-equals(
        parse-json(μ:json(['a', map { 'x': 1 }, ('foo', (['b', 'bar'], 'baz'))])),
        ['a', map { 'x': 1 }, 'foo', ['b', 'bar'], 'baz']
    ),

    (: nodes will be converted to μ-nodes before serializing to JSON :)
    unit:assert-equals(
        parse-json(μ:json(['a', ])),
        ['a', ['b']]
    ),

    (: attribute nodes become string map entry values :)
    unit:assert-equals(
        parse-json(μ:json(['a', <c y="1">foo</c>, '!'])),
        ['a', ['b', ['c', map { 'y': '1' }, 'foo']], '!']
    )

};

declare %unit:test function test:do-xml()
{

    (:~
     : This is the simplest way to build a list.
     :)
    unit:assert-equals(
        μ:xml(['ul',
                for $i in 1 to 3
                return ['li', concat('item ', $i)] ]),

item 1

item 2

item 3

    ),

    unit:assert-equals(
        μ:xml(['ul',
            function($x) {
                for $i in 1 to $x
                return ['li', concat('item ', $i)]
            }])(3),

item 1

item 2

item 3

    )
 (:

    (:~
     : The function may produce XML nodes. This is identical
     : to the above.
     :)
    unit:assert-equals(
        μ:xml(['ul',
            function($x) {
                for $i in 1 to $x
                return element li { concat('item ', $i) }
            }
        ])(3),

item 1

item 2

item 3

    ),

    (:~
     : Produce a table.
     :)
    unit:assert-equals(
        μ:xml(['table',
            function($r,$c) {
                for $i in 1 to $r
                return
                    ['tr',
                        function($r,$c) {
                            for $j in 1 to $c
                            return
                                ['td', concat('item ',$i,',',$j)]
                        }]
            }
        ])((3,2)),

              item 1,1
              item 1,2

              item 2,1
              item 2,2

              item 3,1
              item 3,2

    )
:)
};

declare %unit:test function test:mu()
{

    unit:assert-equals(
        μ:mu(<x/>),
        ['x']),

    unit:assert-equals(
        μ:mu((<x/>, <y/>)),
        (['x'], ['y'])),

    unit:assert-equals(
        μ:mu(<x>hello</x>),
        ['x', 'hello']),

    unit:assert-equals(
        μ:mu(<x><y/></x>),
        ['x', ['y']]),

    unit:assert-equals(
        μ:mu(<x a="10" b="y"/>),
        ['x', map { 'a': '10', 'b': 'y' }]),

    unit:assert-equals(
        μ:mu(<x a="10" b="y">hello</x>),
        ['x', map { 'a': '10', 'b': 'y' }, 'hello']),

    unit:assert-equals(
        μ:mu(<x a="10" b="y">hello world</x>),
        ['x', map { 'a': '10', 'b': 'y' }, 'hello ', ['b', 'world']]),

    unit:assert-equals(
        μ:mu(<x>world</x>),
        ['x', 'world'])

};

declare %unit:test function test:xhtml()
{

    (:~
     : EXPERIMENTAL:
     : This only works for namespaces that are also declared inside
     : the library module. It cannot be changed unilaterally by the user.
     :)
    unit:assert-equals(
        μ:xml(['h:html']),
        <h:html/>
    ),

    unit:assert-equals(
        μ:xml(['h:html', ['x']]),
        <h:html><x/></h:html>
    ),

    unit:assert-equals(
        μ:mu(<h:html><x/></h:html>),
        ['h:html', ['x']]
    )

};


Fixed:
* more than one input-file might be specified
* string comparisons

svn path=/trunk/eXist-1.0/; revision=2709

declare namespace xqts="http://exist-db.org/xquery/xqts";
declare namespace catalog="http://www.w3.org/2005/02/query-test-XQTSCatalog";

import module namespace util="http://exist-db.org/xquery/util";
import module namespace xdb="http://exist-db.org/xquery/xmldb";
import module namespace xdiff="http://exist-db.org/xquery/xmldiff";

(:~ ----------------------------------------------------------------------------------------
     W3C XQuery Test Suite

     This is the main module for running the XQTS on eXist. You can either
     run the whole test suite, a specific test group or a single test case.

     Setup:

     * Make sure the XmlDiff module is registered in conf.xml

     * Change the $xqts:XQTS_HOME variable below to point to the directory into
     which you unzipped the XQTS sources.

     * Create a collection /db/XQTS in the database.

     * From the XQTS directory, upload XQTSCatalog.xml into the created
     collection.

     * Upload the "TestSources" directory so the source docs can be found
     in /db/XQTS/TestSources.

     * Run this script with the client.
     ------------------------------------------------------------------------------------------- :)
declare variable $xqts:XQTS_HOME { "file:///d:/Data/XQTS/" };

declare function xqts:initialize() as empty() {
    let $output-coll := xdb:create-collection("/db/XQTS", "test-results")
    let $dummy := xdb:store("/db/XQTS/test-results", "results.xml", <test-result failed="0" passed="0"/>)
    return ()
};

declare function xqts:get-query($case as element(catalog:test-case)) {
   let $query-name := $case//catalog:query/@name
   let $path := concat( $xqts:XQTS_HOME, "Queries/XQuery/", $case/@FilePath, $query-name, ".xq" )
   let $xq-string := util:file-read($path)
   return $xq-string
};

declare function xqts:print-result($test-name as xs:string, $passed as xs:boolean, $query as xs:string,
    $result as item()*, $expected as item()*, $case as element(catalog:test-case)) as element() {
    <test-case name="{$test-name}" result="{if ($passed) then 'pass' else 'fail'}">
    {
        if (not($passed)) then (
            <result>{$result}</result>,
            <expected>{$expected}</expected>,
            (: element {$case/catalog:input-file/@variable} { xqts:getInputValue($case) }, :)
            <query>{$query}</query>
        ) else ()
    }
    </test-case>
};

declare function xqts:normalize-text($result as item()*) as xs:string {
    let $str := string-join($result, " ")
    return
        (: Remove leading and trailing whitespace :)
        replace(replace($str, "^\s+", ""), "\s+$", "")
};

declare function xqts:check-output($query as xs:string, $result as item()*, $case as element(catalog:test-case)) {
    let $output := $case/catalog:output-file[last()]
    return
        if ($output/@compare eq "Text") then
            let $text := util:file-read(concat($xqts:XQTS_HOME, "ExpectedTestResults/", $case/@FilePath,
                "/", $output/text()))
            let $test := xqts:normalize-text($text) eq xqts:normalize-text($result)
            return
                xqts:print-result($case/@name, $test, $query, $result, $text, $case)
        else if ($output/@compare eq "XML") then
            let $filePath := concat($xqts:XQTS_HOME, "ExpectedTestResults/", $case/@FilePath,
                $output/text())
            let $expected := doc(xdb:store("/db", "temp.xml", xs:anyURI($filePath), "text/xml"))
            let $test := xdiff:compare($expected, $result)
            return
                xqts:print-result($case/@name, $test, $query, $result, $expected, $case)
        else if ($output/@compare eq "Fragment") then
            let $filePath := concat($xqts:XQTS_HOME, "ExpectedTestResults/", $case/@FilePath, $output/text())
            let $xmlFrag := concat("<f>", util:file-read($filePath), "</f>")
            let $log := util:log("DEBUG", ("Frag stored: ", $xmlFrag))
            let $expected := doc(xdb:store("/db", "temp.xml", $xmlFrag, "text/xml"))
            let $test := xdiff:compare($expected, <f>{$result}</f>)
            return
                xqts:print-result($case/@name, $test, $query, $result, $expected, $case)
        else
            <error test="{$case/@name}">Unknown comparison method: {$output/@compare}.</error>
};

declare function xqts:run-test-case( $case as element(catalog:test-case)) as item()* {
   let $query := xqts:get-query($case)
   let $context :=
       <static-context>
       {
           for $input in $case/catalog:input-file
           return
               <variable name="{$input/@variable}">{xqts:get-input-value($input)}</variable>
       }
       </static-context>
   let $result :=
       util:catch("java.lang.Exception",
           let $result :=
               util:eval-with-context($query, $context, false())
           return
               xqts:check-output($query, $result, $case),
           if (exists($case/catalog:expected-error)) then
               <test-case name="{$case/@name}" result="pass"/>
           else
               <test-case name="{$case/@name}" result="fail">
                   <exception>{$util:exception-message}</exception>
                   <query>{$query}</query>
               </test-case>
       )
   return $result
};

declare function xqts:finish() as empty() {
    let $result := doc("/db/XQTS/test-results/results.xml")/test-result
    let $passed := count($result//test-case[@result = 'pass'])
    let $failed := count($result//test-case[@result = 'fail'])
    return (
        update value $result/@passed with xs:int($passed),
        update value $result/@failed with xs:int($failed)
    )
};

declare function xqts:run-single-test-case($case as element(catalog:test-case),
    $group as element()?) as empty() {
    let $result := xqts:run-test-case($case)
    return
        if ($group) then
            update insert $result into $group
        else
            update insert $result into doc("/db/XQTS/test-results/results.xml")/test-result
};

declare function xqts:run-test-group($group as element(catalog:test-group),
    $parent as element()?) as empty() {
    update insert <test-group name="{$group/@name}">{$group/catalog:GroupInfo}</test-group>
        into $parent,
    let $newGroup := $parent/test-group[last()]
    return (
        for $test in $group/catalog:test-case
        let $log := util:log("DEBUG", ("Running test case: ", string($test/@name)))
        return
            xqts:run-single-test-case($test, $newGroup),
        for $childGroup in $group/catalog:test-group
        let $log := util:log("DEBUG", ("Entering group: ", string($childGroup/@name)))
        return
            xqts:run-test-group($childGroup, $newGroup)
    )
};

declare function xqts:test-single($name as xs:string) as empty() {
    let $test := //catalog:test-case[@name = $name]
    return
        xqts:run-single-test-case($test, collection("/db/XQTS/test-results")/test-result)
};

declare function xqts:test-group($groupName as xs:string) as empty() {
    let $group := //catalog:test-group[@name = $groupName]
    return
        xqts:run-test-group($group, collection("/db/XQTS/test-results")/test-result)
};

declare function xqts:test-all() as empty() {
    for $test in /catalog:test-suite/catalog:test-group
    return
        xqts:test-group($test/@name)
};

declare function xqts:get-input-value($input as element(catalog:input-file)) as item()* {
   if ($input eq "emptydoc") then
       ()
   else (
       let $source := root($input)//catalog:source[@ID = $input/text()]
       return
           if (empty($source)) then
               concat("no input found: ", $input/text())
           else
               doc(concat("/db/XQTS/", $source/@FileName))
   )
};

xqts:initialize(),
(: xqts:test-single("Axes001"), :)
xqts:test-group("SeqExpr"),
xqts:finish(),
doc("/db/XQTS/test-results/results.xml")

declare namespace xqts="http://exist-db.org/xquery/xqts";
declare namespace catalog="http://www.w3.org/2005/02/query-test-XQTSCatalog";

import module namespace util="http://exist-db.org/xquery/util";
import module namespace xdb="http://exist-db.org/xquery/xmldb";
import module namespace xdiff="http://exist-db.org/xquery/xmldiff";

(:~ ----------------------------------------------------------------------------------------
     W3C XQuery Test Suite

     This is the main module for running the XQTS on eXist. You can either
     run the whole test suite, a specific test group or a single test case.

     Setup:

     * Make sure the XmlDiff module is registered in conf.xml

     * Change the $xqts:XQTS_HOME variable below to point to the directory into
     which you unzipped the XQTS sources.

     * Create a collection /db/XQTS in the database.

     * From the XQTS directory, upload XQTSCatalog.xml into the created
     collection.

     * Upload the "TestSources" directory so the source docs can be found
     in /db/XQTS/TestSources.

     * Run this script with the client.
     ------------------------------------------------------------------------------------------- :)
declare variable $xqts:XQTS_HOME { "file:///d:/Data/XQTS/" };

declare function xqts:initialize() as empty() {
    let $output-coll := xdb:create-collection("/db/XQTS", "test-results")
    let $dummy := xdb:store("/db/XQTS/test-results", "results.xml", <test-result failed="0" passed="0"/>)
    return ()
};

declare function xqts:get-query($case as element(catalog:test-case)) {
   let $query-name := $case//catalog:query/@name
   let $path := concat( $xqts:XQTS_HOME, "Queries/XQuery/", $case/@FilePath, $query-name, ".xq" )
   let $xq-string := util:file-read($path)
   return $xq-string
};

declare function xqts:print-result($test-name as xs:string, $passed as xs:boolean, $query as xs:string,
    $result as item()*, $expected as item()*, $case as element(catalog:test-case)) as element() {
    <test-case name="{$test-name}" result="{if ($passed) then 'pass' else 'fail'}">
    {
        if (not($passed)) then (
            <result>{$result}</result>,
            <expected>{$expected}</expected>,
            (: element {$case/catalog:input-file/@variable} { xqts:getInputValue($case) }, :)
            <query>{$query}</query>
        ) else ()
    }
    </test-case>
};

declare function xqts:check-output($query as xs:string, $result as item()*, $case as element(catalog:test-case)) {
    let $output := $case/catalog:output-file[last()]
    return
        if ($output/@compare eq "Text") then
            let $text := util:file-read(concat($xqts:XQTS_HOME, "ExpectedTestResults/", $case/@FilePath,
                "/", $output/text()))
            let $test := $text eq string($result[1])
            return
                xqts:print-result($case/@name, $test, $query, $result, $text, $case)
        else if ($output/@compare eq "XML") then
            let $filePath := concat($xqts:XQTS_HOME, "ExpectedTestResults/", $case/@FilePath,
                $output/text())
            let $expected := doc(xdb:store("/db", "temp.xml", xs:anyURI($filePath), "text/xml"))
            let $test := xdiff:compare($expected, $result)
            return
                xqts:print-result($case/@name, $test, $query, $result, $expected, $case)
        else if ($output/@compare eq "Fragment") then
            let $filePath := concat($xqts:XQTS_HOME, "ExpectedTestResults/", $case/@FilePath, $output/text())
            let $xmlFrag := concat("<f>", util:file-read($filePath), "</f>")
            let $log := util:log("DEBUG", ("Frag stored: ", $xmlFrag))
            let $expected := doc(xdb:store("/db", "temp.xml", $xmlFrag, "text/xml"))
            let $test := xdiff:compare($expected, <f>{$result}</f>)
            return
                xqts:print-result($case/@name, $test, $query, $result, $expected, $case)
        else
            <error test="{$case/@name}">Unknown comparison method: {$output/@compare}.</error>
};

declare function xqts:run-test-case( $case as element(catalog:test-case)) as item()* {
   let $query := xqts:get-query($case)
   let $input-value := xqts:getInputValue($case)
   let $context :=
       <static-context>
           <variable name="{$case/catalog:input-file/@variable}">{$input-value}</variable>
       </static-context>
   let $result :=
       util:catch("org.exist.xquery.XPathException",
           let $result :=
               util:eval-with-context($query, $context, false())
           return
               xqts:check-output($query, $result, $case),
           if (exists($case/catalog:expected-error)) then
               <test-case name="{$case/@name}" result="pass"/>
           else
               <test-case name="{$case/@name}" result="fail">
                   <exception>{$util:exception-message}</exception>
                   <query>{$query}</query>
               </test-case>
       )
   return $result
};

declare function xqts:finish() as empty() {
    let $result := doc("/db/XQTS/test-results/results.xml")/test-result
    let $passed := count($result//test-case[@result = 'pass'])
    let $failed := count($result//test-case[@result = 'fail'])
    return (
        update value $result/@passed with xs:int($passed),
        update value $result/@failed with xs:int($failed)
    )
};

declare function xqts:run-single-test-case($case as element(catalog:test-case),
    $group as element()?) as empty() {
    let $result := xqts:run-test-case($case)
    return
        if ($group) then
            update insert $result into $group
        else
            update insert $result into doc("/db/XQTS/test-results/results.xml")/test-result
};

declare function xqts:run-test-group($group as element(catalog:test-group),
    $parent as element()?) as empty() {
    update insert <test-group name="{$group/@name}">{$group/catalog:GroupInfo}</test-group>
        into $parent,
    let $newGroup := $parent/test-group[last()]
    return (
        for $test in $group/catalog:test-case
        let $log := util:log("DEBUG", ("Running test case: ", string($test/@name)))
        return
            xqts:run-single-test-case($test, $newGroup),
        for $childGroup in $group/catalog:test-group
        let $log := util:log("DEBUG", ("Entering group: ", string($childGroup/@name)))
        return
            xqts:run-test-group($childGroup, $newGroup)
    )
};

declare function xqts:test-single($name as xs:string) as empty() {
    let $test := //catalog:test-case[@name = $name]
    return
        xqts:run-single-test-case($test, collection("/db/XQTS/test-results")/test-result)
};

declare function xqts:test-group($groupName as xs:string) as empty() {
    let $group := //catalog:test-group[@name = $groupName]
    return
        xqts:run-test-group($group, collection("/db/XQTS/test-results")/test-result)
};

declare function xqts:test-all() as empty() {
    for $test in /catalog:test-suite/catalog:test-group
    return
        xqts:test-group($test/@name)
};

declare function xqts:getInputValue($case as element(catalog:test-case)) as item()* {
	let $input := $case/catalog:input-file
  	return
       if ($input eq "emptydoc") then
           ()
       else (
           let $source := root($case)//catalog:source[@ID = $input/text()]
           return
               if (empty($source)) then
                   concat("no input found: ", $input/text())
               else
                   doc(concat("/db/XQTS/", $source/@FileName))
       )
};

xqts:initialize(),
(: xqts:test-single("Axes001"), :)
xqts:test-group("PathExpr"),
xqts:finish(),
doc("/db/XQTS/test-results/results.xml")