<commit_before>
 (define-library (pikkukivi command ääliö main)
    (export
      ääliö)
  (import
    (scheme base)
    (scheme write)
    (gauche base)
    (gauche process) ; run-process
    (gauche parseopt)
    (srfi 13)
    (srfi 37)
    (util match)
    (file util) ; directory-list, current-directory
    (maali)
    (clojure)
    (kirjasto merkkijono)
    (kirjasto list)
    (kirjasto tiedosto))

  (begin

    (define *gitdir*  (expand-path "~/huone/git/"))

    (define (do-root)
      (println *gitdir*))

    ;; update git repository
    (define (do-update)
      (let ((repos (find-git-repository *gitdir*)))
        (for-each
            (lambda (r)
              (update-git-repository r))
          repos)
        (println "update finished!")))

    (define (update-git-repository dir)
      (display (paint "=> " 4))
      (println (paint (sys-basename dir) 3))
      (run-process `(git -C ,dir pull) :wait #true)
      (newline))

    (define (git-repository? directory)
      (file-exists? (build-path directory ".git")))

    (define (find-git-repository directory)
      (flatten
       (map
           (lambda (d)
             (if (git-repository? d)
               d
               (find-git-repository d)))
         (directory-list2 directory
                          :children? #true
                          :add-path? #true))))

    ;; clean git repository with "git gc"
    (define (do-clean)
      (let ((dirs (list (directory-list (expand-path *gitdir*) :children? #true :add-path? #true))))
        (let loop ((dirs (car dirs)))
             (cond
               ((null? dirs)
                (display "cleaning finished!\n"))
               (else
                   (cond
                     ((file-is-directory? (car dirs))
                      (display (paint "=> " 4))
                      (println (paint (sys-basename (car dirs)) 3))
                      (run-process '(git gc) :wait #true :directory (car dirs))
                      (newline))
                     (else  #true))
                 (loop (cdr dirs)))))))



    (define (do-list args)
      (receive (full-path?)
        (args-fold (cdr args)
          options-list
          (lambda (option name arg . seeds)
            (error "Unrecognized option:" name))
          (lambda (operand full-path)
            (values full-path))
          #false)
        (let ((repos (find-git-repository *gitdir*)))
          (if full-path?
            (map
                println
              repos)
            (map
                (lambda (r)
                  (println (string-drop r (string-length *gitdir*))))
              repos)))))

    (define (do-usage status)
      (exit status "usage: ~a <command> <package-name>\n" "ääliö"))

    (define (do-get url)
      (let* ((path (format-url->path url))
             (full-path (string-append *gitdir* path))
             (git-url (format-url->git url)))
        (println git-url)
        (run-process `(git clone --depth 1 ,git-url ,path) :wait #true)))

    (define (format-url->path url)
      (cond
        ((= 1 (string-count url #\/))
         (string-append "github.com/" url))
        (else
            (trim-url-prefix url))))

    (define (format-url->git url)
      (cond
        ((= 1 (string-count url #\/))
         (string-append "git://github.com/" url))
        (else
            (string-append "git://" (trim-url-prefix url)))))

    (define (trim-url-prefix url)
      (define (drop-prefix u prefix)
        (string-drop u (string-length prefix)))
      (cond ((url-protocol=? "http" url)
             (drop-prefix url "http://"))
            ((url-protocol=? "https" url)
             (drop-prefix url "https://"))
            ((url-protocol=? "git" url)
             (drop-prefix url "git://"))))

    (define (url-protocol=? p url)
      (let ((proto (string-append p "://")))
        (string= proto
          (string-take url (string-length proto)))))

    (define options
      (list (option '(#\h "help") (not 'require-arg?) (not 'optional-arg?)
                    (lambda (option name arg help)
                      (values #true)))))

    (define options-list
      (list (option '(#\p "full-path") (not 'require-arg?) (not 'optional-arg?)
                    (lambda (option name arg full-path)
                      (values #true)))))

    (define (ääliö args)
      (receive (help)
        (args-fold args
          options
          (lambda (option name arg . seeds)
            #false)
          (lambda (operand help)
            (values help))
          #false ; default help
          )
        (cond
          (help
           (do-usage 0))
          (else
              (with-cwd *gitdir*
                        (match (car args)
                               ;; commands
                               ((or "update" "up")
                                (begin
                                  (print (string-append (paint "updating " 8) "repositories"))
                                  (do-update)))
                               ("clean"
                                (do-clean))
                               ("list"<commit_msg>* lib/pikkukivi/command/ääliö/main.scm: add message function<commit_after>
 (define-library (pikkukivi command ääliö main)
    (export
      ääliö)
  (import
    (scheme base)
    (scheme write)
    (scheme process-context)
    (gauche base)
    (gauche process) ; run-process
    (gauche parseopt)
    (srfi 13)
    (srfi 37)
    (util match)
    (file util) ; directory-list, current-directory
    (maali)
    (clojure)
    (kirjasto merkkijono)
    (kirjasto list)
    (kirjasto tiedosto))

  (begin

    (define *ääliöpath*
      (let ((ääliöpath (get-environment-variable "ääliöpath")))
        (if ääliöpath
          ääliöpath
          (expand-path "~/huone/git/"))))

    (define (do-root)
      (println *ääliöpath*))

    ;; update git repository
    (define (do-update)
      (let ((repos (find-git-repository *ääliöpath*)))
        (for-each
            (lambda (r)
              (update-git-repository r))
          repos)
        (println "update finished!")))

    (define (update-git-repository dir)
      (message-update dir)
      (run-process `(git -C ,dir pull) :wait #true)
      (newline))

    (define (message-update dir)
      (display (paint "=> " 4))
      (display (paint (sys-basename dir) 3))
      (display " ")
      (println (paint (string-drop dir (string-length *ääliöpath*))
                      39)))

    (define (git-repository? directory)
      (file-exists? (build-path directory ".git")))

    (define (find-git-repository directory)
      (flatten
       (map
           (lambda (d)
             (if (git-repository? d)
               d
               (find-git-repository d)))
         (directory-list2 directory
                          :children? #true
                          :add-path? #true))))

    ;; clean git repository with "git gc"
    (define (do-clean)
      (let ((dirs (list (directory-list (expand-path *ääliöpath*) :children? #true :add-path? #true))))
        (let loop ((dirs (car dirs)))
             (cond
               ((null? dirs)
                (display "cleaning finished!\n"))
               (else
                   (cond
                     ((file-is-directory? (car dirs))
                      (display (paint "=> " 4))
                      (println (paint (sys-basename (car dirs)) 3))
                      (run-process '(git gc) :wait #true :directory (car dirs))
                      (newline))
                     (else  #true))
                 (loop (cdr dirs)))))))



    (define (do-list args)
      (receive (full-path?)
        (args-fold (cdr args)
          options-list
          (lambda (option name arg . seeds)
            (error "Unrecognized option:" name))
          (lambda (operand full-path)
            (values full-path))
          #false)
        (let ((repos (find-git-repository *ääliöpath*)))
          (if full-path?
            (map
                println
              repos)
            (map
                (lambda (r)
                  (println (string-drop r (string-length *ääliöpath*))))
              repos)))))

    (define (do-usage status)
      (exit status "usage: ~a <command> <package-name>\n" "ääliö"))

    (define (do-get url)
      (let* ((path (format-url->path url))
             (full-path (string-append *ääliöpath* path))
             (git-url (format-url->git url)))
        (println git-url)
        (run-process `(git clone --depth 1 ,git-url ,path) :wait #true)))

    (define (format-url->path url)
      (cond
        ;; user/repo
        ((= 1 (string-count url #\/))
         (string-append "github.com/" url))
        ;; github.com/user/repo
        ((and (= 2 (string-count url #\/))
           (string-prefix? "github.com" url))
         url)
        (else
            (trim-url-prefix url))))

    (define (format-url->git url)
      (cond
        ((= 1 (string-count url #\/))
         (string-append "git://github.com/" url))
        ((and (= 2 (string-count url #\/))
           (string-prefix? "github.com" url))
         (string-append "git://" url))
        (else
            (string-append "git://" (trim-url-prefix url)))))

    (define (trim-url-prefix url)
      (define (drop-prefix u prefix)
        (string-drop u (string-length prefix)))
      (cond ((url-protocol=? "http" url)
             (drop-prefix url "http://"))
            ((url-protocol=? "https" url)
             (drop-prefix url "https://"))
            ((url-protocol=? "git" url)
             (drop-prefix url "git://"))))

    (define (url-protocol=? p url)
      (let ((proto (string-append p "://")))
        (string= proto
          (string-take url (string-length proto)))))

    (define options
      (list (option '(#\h "help") (not 'require-arg?) (not 'optional-arg?)
                    (lambda (option name arg help)
                      (values #true)))))

    (define options-list
      (list (option '(#\p "full-path") (not 'require-arg?) (not 'optional-arg?)
                    (lambda (option name arg full-path)
                      (values #true)))))

    (define (ääliö args)
      (receive (help)
        (args-fold args
          options
          (lambda (option name arg . seeds)
            #false)
          (lambda (operand help)
            (values help))
          #false ; default help
          )
        (cond
          (help
           (do-usage 0))
          (else
              (with-cwd *ääliöpath*
                        (match (car args)
                               ;; commands
                               ((or "update" "up")
                                (begin
                                  (print (string-append (paint "updating " 8) "repositories"))
                                  (do-update)))
                               ("clean"
                                (do-clean))
                               ("list"
{'fraction_non_alphanumeric': 0.14473684210526316, 'fraction_numerical': 0.0029239766081871343, 'mean_word_length': 1.4236049601417184, 'pattern_counts': {'":': 2, '<': 7, '<?xml version=': 0, '>': 19, 'https://': 2, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 6, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '4905818', 'n_tokens_mistral': 3331, 'n_tokens_neox': 3175, 'n_words': 839}