<commit_before>;;; sukkiri-lib.scm -- A metadata store based on Redis
;;;   Copyright © 2012 by <NAME> <<EMAIL>>
;;;   This program is open-source software, released under the
;;;   BSD License. See the accompanying LICENSE file for details.

(module sukkiri-lib
;        *
        (*sukkiri-debug*
         make-prop-type
         make-prop-list
         make-prop-set
         make-irregex-validator
         make-enum-validator
         register-prop-type
         register-list-type
         register-set-type
         unregister-prop-type
         make-prop-spec
         create-atomic-prop-spec
         create-struct-prop-spec
         register-resource-type
         xml->register-types
         index-add!
         index-delete!
         index-exists?
         get-index
         make-prop-responder
         create-resource-proxy
         create-resource
         load-resource-proxy
         delete-resource!)

        (import scheme)
        (import chicken)
        (import extras)
        (import data-structures)
        (import ports)
        (import srfi-1)
        (import srfi-69)
        (import sukkiri-db)

        (use srfi-19)
        (use numbers)
        (use mathh)
        (use sets)
        (use irregex)
        (use yasos)
        (use s11n) ; FIXME -- using because date->secstring is not working


;;; IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
;;; ----  GLOBAL PARAMETERS  -----------------------------------------------

(define *sukkiri-debug* (make-parameter #f))

;;; OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO



;;; IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
;;; ----  UTILITY FUNCTIONS  -----------------------------------------------

(define (eprintf fmt . args)
  (error (apply sprintf (cons fmt args))))

(define (debug-msg . msgs)
  (when (*sukkiri-debug*)
    (with-output-to-port
      (current-error-port)
      (lambda () (apply print msgs)))))

(define (ymd->date y m d)
  (make-date 0 0 0 0 d m y))

(define (ymdhms->date yr mo dt hr mi #!optional (se 0))
  (make-date 0 se mi hr dt mo yr))

(define (set-map proc input-set)
  (let ((output-set (make-empty-set)))
    (set-for-each
      (lambda (mem)
        (set-add! output-set (proc mem)))
      input-set)
    output-set))

(define (null-hook _ _ _) #f)

;;; OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO



;;; IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
;;; ----  PROPERTIES  ------------------------------------------------------

;;; ========================================================================
;;; ----  Basic property type  ---------------------------------------------

;;; ------  Interface  -----------------------------------------------------

(define-predicate property?) 
(define-operation (prop-type obj))
(define-operation (base-type obj))
(define-operation (get-val obj))
(define-operation (set-val! obj new-val))
(define-operation (store obj new-val))
(define-operation (retrieve obj))

;;; ------  Implementation  ------------------------------------------------

;;; make-property should not be used directly in application code. It is
;;;   intended to be a basis for defining more specific types in extension
;;;   code.
(define (make-property ptype base res-id prop-name #!key (init-val #f)
                       (valid? (lambda (_) #f)) (to-string (lambda (x) x))
                       (from-string (lambda (s) s)))
  (let ((value init-val)
        (db-result #f))
    (object
      ((property? self) #t)
      ((prop-type self) ptype)
      ((base-type self) base)
      ((get-val self) value)
      ((set-val! self new-val)
       (if (valid? new-val)
         (set! value new-val)
         (error (sprintf "Invalid input for ~A!" ptype))))
      ((store self new-val) (redis-hset res-id prop-name (to-string new-val)))
      ((retrieve self)
       (let ((rs (redis-hget res-id prop-name)))
         (to-string (car rs))))
      (else
        (error (sprintf "Unrecognized message."))))))


;;; ========================================================================
;;; ----  String Type  -----------------------------------------------------

;;; ------  Interface-------------------------------------------------------

(define-predicate string-property?)<commit_msg>Got the proptype interface worked out, maybe.<commit_after>;;; sukkiri-lib.scm -- A metadata store based on Redis
;;;   Copyright © 2012 by <NAME> <<EMAIL>>
;;;   This program is open-source software, released under the
;;;   BSD License. See the accompanying LICENSE file for details.

(module sukkiri-lib
;        *
        (*sukkiri-debug*
         make-prop-type
         make-prop-list
         make-prop-set
         make-irregex-validator
         make-enum-validator
         register-prop-type
         register-list-type
         register-set-type
         unregister-prop-type
         make-prop-spec
         create-atomic-prop-spec
         create-struct-prop-spec
         register-resource-type
         xml->register-types
         index-add!
         index-delete!
         index-exists?
         get-index
         make-prop-responder
         create-resource-proxy
         create-resource
         load-resource-proxy
         delete-resource!)

        (import scheme)
        (import chicken)
        (import extras)
        (import data-structures)
        (import ports)
        (import srfi-1)
        (import srfi-69)
        (import sukkiri-db)

        (use srfi-19)
        (use numbers)
        (use mathh)
        (use sets)
        (use irregex)
        (use yasos)
        (use s11n) ; FIXME -- using because date->secstring is not working


;;; IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
;;; ----  GLOBAL PARAMETERS  -----------------------------------------------

(define *sukkiri-debug* (make-parameter #f))

;;; OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO



;;; IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
;;; ----  UTILITY FUNCTIONS  -----------------------------------------------

(define (eprintf fmt . args)
  (error (apply sprintf (cons fmt args))))

(define (debug-msg . msgs)
  (when (*sukkiri-debug*)
    (with-output-to-port
      (current-error-port)
      (lambda () (apply print msgs)))))

(define (ymd->date y m d)
  (make-date 0 0 0 0 d m y))

(define (ymdhms->date yr mo dt hr mi #!optional (se 0))
  (make-date 0 se mi hr dt mo yr))

(define (set-map proc input-set)
  (let ((output-set (make-empty-set)))
    (set-for-each
      (lambda (mem)
        (set-add! output-set (proc mem)))
      input-set)
    output-set))

(define (null-hook _ _ _) #f)

;;; OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO



;;; IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
;;; ----  PROPERTY TYPES  --------------------------------------------------

;;; ========================================================================
;;; ----  Basic property type  ---------------------------------------------

;;; ------  Interface  -----------------------------------------------------

(define-predicate proptype?) 
(define-operation (base-type obj))
(define-operation (structure obj))
(define-operation (store obj new-val))
(define-operation (retrieve obj))
(define-operation (delete obj))

;;; ------  Implementation  ------------------------------------------------

;;; FIXME: this is not right--still need to figure out how we interface w/
;;;   the DB module
(define (make-proptype base valid? ->dbformat dbformat-> delete)
  (object
    ((proptype? self) #t)
    ((base-type self) base)
    ((structure self) #f)
    (else
      (error (sprintf "Unrecognized message."))))))


;;; ========================================================================
;;; ----  String Type  -----------------------------------------------------

;;; ------  Interface-------------------------------------------------------

(define-predicate string-property?)
{'fraction_non_alphanumeric': 0.24796145292809488, 'fraction_numerical': 0.004200642451198419, 'mean_word_length': 1.8373641780581844, 'pattern_counts': {'":': 0, '<': 9, '<?xml version=': 0, '>': 19, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 2}, 'pii_count': 0, 'substrings_counts': 10, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '4391319', 'n_tokens_mistral': 2494, 'n_tokens_neox': 2412, 'n_words': 563}