next round of refactoring

src/modules/app.xql

@@ -164,35 +164,19 @@ declare function app:write-apikey($collection as xs:string, $apikey as xs:string
  : Write lock file
  :)
 declare function app:lock-write($collection as xs:string, $task as xs:string) {
-    try {
+    if (xmldb:collection-available($collection)) then (
         xmldb:store($collection, config:lock(),
             <task><value>{ $task }</value></task>)
-    }
-    catch * {
-        map {
-            "_error": map {
-                "code": $err:code, "description": $err:description, "value": $err:value, 
-                "line": $err:line-number, "column": $err:column-number, "module": $err:module
-            }
-        }
-    }
+    ) else ()
 };
 
 (:~
  : Delete lock file
  :)
 declare function app:lock-remove($collection as xs:string) {
-    try {
+    if (doc-available($collection || "/" || config:lock())) then (
         xmldb:remove($collection, config:lock())
-    }
-    catch * {
-        map {
-            "_error": map {
-                "code": $err:code, "description": $err:description, "value": $err:value, 
-                "line": $err:line-number, "column": $err:column-number, "module": $err:module
-            }
-        }
-    }
+    ) else ()
 };
 
 (:~
@@ -312,6 +296,50 @@ declare function app:request($request as element(http:request)) {
         else $response
 };
 
-declare function app:extract-archive($zip, $collection as xs:string) {
+declare function app:extract-archive($zip as xs:base64Binary, $collection as xs:string) {
     compression:unzip($zip, app:unzip-filter#3, (), app:unzip-store#4, $collection)
-};
+};
+
+(:~
+ : resolve file path against a base collection
+ : $base the absolute DB path to a collection. Assumes no slash at the end
+ : $filepath never begins with slash and always points to a resource
+    ("/db", "a/b/c") -> map { "name": "c", "collection": "/db/a/b/"}
+ :)
+declare function app:file-to-resource($base as xs:string, $filepath as xs:string) as map(*) {
+    let $parts := tokenize($filepath, '/')
+    let $rel-path := subsequence($parts, 0, count($parts)) (: cut off last part :)
+    return map {
+        "name": xmldb:encode($parts[last()]),
+        "collection": string-join(($base, $rel-path), "/") || "/"
+    }
+};
+
+declare function app:delete-resource($config as map(*), $filepath as xs:string) as xs:boolean {
+    let $resource := app:file-to-resource($config?path, $filepath)
+    let $remove := xmldb:remove($resource?collection, $resource?name)
+    let $remove-empty-col := 
+        if (empty(xmldb:get-child-resources($resource?collection))) then (
+            xmldb:remove($resource?collection)
+        ) else ()
+
+    return true()
+};
+
+(:~
+ : Incremental update fetch and add files from git
+ :)
+declare function app:add-resource($config as map(*), $filepath as xs:string, $data as item()) as xs:boolean {
+    let $resource := app:file-to-resource($config?path, $filepath)
+
+    let $collection-check := 
+        if (xmldb:collection-available($resource?collection)) then ()
+        else (
+            app:mkcol($resource?collection),
+            app:set-permission($config?collection, $resource?collection, "collection")
+        )
+
+    let $store := xmldb:store($resource?collection, $resource?name, $data)
+    let $chmod := app:set-permission($config?collection, $resource?collection || $resource?name, "resource")
+    return true()
+};

src/modules/collection.xqm

@@ -0,0 +1,70 @@
+xquery version '3.1';
+
+module namespace collection="http://existsolutions.com/modules/collection";
+
+(:~
+ : create arbitrarily deep-nested sub-collection
+ : @param   $new-collection absolute path that starts with "/db"
+ :          the string can have a slash at the end
+ : @returns map(*) with xs:boolean success, xs:string path and xs:string error,
+ :          if something went wrong error contains the description and path is
+ :          the collection where the error occurred
+~:)
+declare
+function collection:create ($path as xs:string) as map(*) {
+    if (not(starts-with($path, '/db')))
+    then (
+        map {
+            'success': false(),
+            'path': $path,
+            'error': 'New collection must start with /db'
+        }
+    )
+    else (
+        fold-left(
+            tail(tokenize($path, '/')),
+            map { 'success': true(), 'path': '' },
+            collection:fold-collections#2
+        )
+    )
+};
+
+declare
+    %private
+function collection:fold-collections ($result as map(*), $next as xs:string*) as map(*) {
+    let $path := concat($result?path, '/', $next)
+
+    return
+        if (not($result?success))
+        then ($result)
+        else if (xmldb:collection-available($path))
+        then (map { 'success': true(), 'path': $path })
+        else (
+            try {
+                map {
+                    'success': exists(xmldb:create-collection($result?path, $next)),
+                    'path': $path
+                }
+            }
+            catch * {
+                map {
+                    'success': false(),
+                    'path': $path,
+                    'error': $err:description
+                }
+            }
+        )
+};
+
+declare function collection:remove($path as xs:string, $force as xs:boolean) {
+    if (not(xmldb:collection-available($path)))
+    then true()
+    else if ($force) 
+    then xmldb:remove($path)
+    else if (not(empty((
+        xmldb:get-child-resources($path),
+        xmldb:get-child-collections($path)
+    ))))
+    then error(xs:QName("collection:not-empty"), "Collection '" || $path || "' is not empty and $force is false().")
+    else xmldb:remove($path)
+};

src/modules/config.xql

@@ -10,9 +10,9 @@ declare variable $config:tuttle-config as element(tuttle) := doc("/db/apps/tuttl
 (:~
  : Git configuration
  :)
-declare function config:collections($collection as xs:string) as map(*)? {
-    let $collection-config := $config:tuttle-config/repos/collection[@name = $collection]
-    let $path := config:prefix() || $collection
+declare function config:collections($collection-name as xs:string) as map(*)? {
+    let $collection-config := $config:tuttle-config/repos/collection[@name = $collection-name]
+    let $path := config:prefix() || $collection-name
 
     return
         if (empty($collection-config))
@@ -23,10 +23,11 @@ declare function config:collections($collection as xs:string) as map(*)? {
             "repo" : $collection-config/repo/string(),
             "owner" : $collection-config/owner/string(),
             "project-id" : $collection-config/project-id/string(),
+            "ref": $collection-config/ref/string(),
+            "collection": $collection-name,
+
             "type": $collection-config/type/string(),
             "baseurl": $collection-config/baseurl/string(),
-            "ref": $collection-config/ref/string(),
-            "collection": $collection-config/@name/string(),
             "hookuser":  $collection-config/hookuser/string(),
 
             "path": $path,
@@ -73,7 +74,7 @@ declare function config:list-collections() as xs:string* {
 
 
 (:~
- : Defile default collection
+ : get default collection
  :)
 declare function config:default-collection() as xs:string? {
     $config:tuttle-config/repos/collection[default="true"]/@name/string()

src/modules/github.xql

@@ -32,34 +32,9 @@ declare function github:commit-ref-url($config as map(*), $per-page as xs:intege
 (:~
  : Clone defines Version repo
  :)
-declare function github:clone($config as map(*), $collection as xs:string, $sha as xs:string?) as map(*) {
-    try {
-        let $zip := github:request(
-            github:repo-url($config) || "/zipball/" || $sha, $config?token)
-
-        let $delete-collection :=
-            if (xmldb:collection-available($collection))
-            then xmldb:remove($collection)
-            else ()
-
-        let $create-collection := xmldb:create-collection("/", $collection)
-
-        let $write-sha := app:write-sha($collection,
-            if (exists($sha)) then $sha else github:get-last-commit($config)?sha)
-
-        let $clone := app:extract-archive($zip, $collection)
-
-        return map { "message" : "success" }
-    }
-    catch * {
-        map {
-            "message": $err:description,
-            "_error": map {
-                "code": $err:code, "description": $err:description, "value": $err:value, 
-                "line": $err:line-number, "column": $err:column-number, "module": $err:module
-            }
-        }
-    }
+declare function github:get-archive($config as map(*), $sha as xs:string) as xs:base64Binary {
+    github:request(
+        github:repo-url($config) || "/zipball/" || $sha, $config?token)
 };
 
 (:~
@@ -193,10 +168,13 @@ declare function github:incremental-dry($config as map(*)) {
 declare function github:incremental($config as map(*)) {
     let $sha := github:get-last-commit($config)?sha
     let $changes := github:get-changes($config)
+    let $new := github:incremental-add($config, $changes?new, $sha)
     let $del := github:incremental-delete($config, $changes?del)
-    let $add := github:incremental-add($config, $changes?new, $sha)
     let $writesha := app:write-sha($config?path, $sha)
-    return ($del, $add) 
+    return map {
+        'new': array{ $new },
+        'del': array{ $del }
+    }
 };
 
 
@@ -213,12 +191,11 @@ declare function github:get-commit-files($config as map(*), $sha as xs:string) a
 (:~
  : Get blob of a file
  :)
-declare function github:get-blob($config as map(*), $filename as xs:string, $sha as xs:string) {
+declare function github:get-blob($config as map(*), $filename as xs:string, $sha as xs:string) as xs:string {
     let $blob-url := github:repo-url($config) || "/contents/" || escape-html-uri($filename) || "?ref=" || $sha
-    let $json := github:request-json($blob-url, $config?token)
-
-    return
-        util:base64-decode($json?content)
+    let $content := github:request-json($blob-url, $config?token)?content
+
+    return util:base64-decode($content)
 };
 
 (:~
@@ -244,64 +221,36 @@ declare function github:check-signature($collection as xs:string, $apikey as xs:
 (:~ 
  : Incremental updates delete files
  :)
-declare %private function github:incremental-delete($config as map(*), $files as xs:string*) {
-    for $resource in $files
-    let $resource-path := tokenize($resource, '[^/]+$')[1]
-    let $resource-collection := $config?path || "/" || $resource-path
-    let $resource-filename := xmldb:encode(replace($resource, $resource-path, ""))
-
-    return
+declare %private function github:incremental-delete($config as map(*), $files as xs:string*) as array(*)* {
+    for $filepath in $files
+    return 
         try {
-            let $remove := xmldb:remove($resource-collection, $resource-filename)
-            let $remove-empty-col := 
-                if (empty(xmldb:get-child-resources($resource-collection))) then
-                    xmldb:remove($resource-collection)
-                    else ()
-            return ()
+            [ $filepath, app:delete-resource($config, $filepath) ]
         }
         catch * {
-            map {
-                "resource": $resource,
-                "code": $err:code, "description": $err:description, "value": $err:value, 
+            [ $filepath, false(), map{
+                "code": $err:code, "description": $err:description, "value": $err:value,
                 "line": $err:line-number, "column": $err:column-number, "module": $err:module
-            }
+            }]
         }
 };
 
 (:~
  : Incremental update fetch and add files from git
  :)
-declare %private function github:incremental-add($config as map(*), $files as xs:string*, $sha as xs:string) {
-    for $resource in $files
-    let $resource-path := tokenize($resource, '[^/]+$')[1]
-    let $resource-collection := $config?path || "/" || $resource-path
-    let $resource-filename :=
-        if ($resource-path = "") then
-            xmldb:encode($resource)
-        else
-            xmldb:encode(replace($resource, $resource-path, ""))
-
-    let $resource-fullpath := $resource-collection || $resource-filename
-
+declare %private function github:incremental-add($config as map(*), $files as xs:string*, $sha as xs:string) as array(*)* {
+    for $filepath in $files
     return 
         try {
-            let $data := github:get-blob($config, $resource, $sha)
-            let $collection-check := 
-                if (xmldb:collection-available($resource-collection)) then ()
-                else (
-                    app:mkcol($resource-collection),
-                    app:set-permission($config?collection, $resource-collection, "collection")
-                )
-            let $store := xmldb:store($resource-collection, $resource-filename, $data)
-            let $chmod := app:set-permission($config?collection, $resource-fullpath, "resource")
-            return ()
+            [ $filepath,
+                app:add-resource($config, $filepath,
+                    github:get-blob($config, $filepath, $sha))]
         }
         catch * {
-            map {
-                "resource": $resource,
-                "code": $err:code, "description": $err:description, "value": $err:value, 
+            [ $filepath, false(), map{
+                "code": $err:code, "description": $err:description, "value": $err:value,
                 "line": $err:line-number, "column": $err:column-number, "module": $err:module
-            }
+            }]
         }
 };