(library (test helper sph-cms)
  (export
    default-config
    delete-test-directory
    insert-test-data)
  (import
    (sph-cms other type)
    (sph filesystem) (sph hashtable) (sph io) (sph list) (sph number) (sph other) (sph process) (sph string) (sph vector) (sph)
    (sph storage dg)
    (sph storage dg file)
    (sph storage dg tag))

  (define (insert-test-data data)
    "tid: test-id
     example:
     (define-as data list-qq
       ; content-class content-string type-name
       (content 1 \"test-1\" \"plaintext\") (content 2 (unquote data-itml-simple) \"itml\")
       (tag-relation \"tag-1\" 1) (tag-relation \"tag-2\" 1 2))"
    (dg-txn-call-write
      (l (txn)
        (fold
          (l (a r)
            (case (first a)
              ( (content)
                (list-bind (tail a) (tid data type-name)
                  (let (id (dg-file-from-data txn data))
                    (cms-type-set txn (cms-type-ref-first name id type-name) (list id))
                    (ht-set! r tid (vector id data type-name)) r)))
              ( (tag-relation)
                (apply
                  (l (name . tid)
                    (let
                      ( (content (map (l (a) (ht-ref r a)) tid))
                        (tag-ids (dg-intern-ensure txn (list name))))
                      (dg-tag-add txn tag-ids (map vector-first content))
                      (ht-set! r name (first tag-ids)) r))
                  (tail a)))
              (else r)))
          (ht-create) data))))

  (define-as default-config ht-create-symbol
    dg-root "/tmp/sph-cms-test"
    preview-image-size 256
    include-types (list "itml" "plaintext")
    default-page-title "cms" socket-permissions 504 mode (q development))

  (define (delete-test-directory dg-root)
    (if (and (string-equal? "/tmp/sph-cms-test" dg-root) (file-exists? dg-root))
      (execute "rm" "-r" dg-root))))