How to search for files with a wildcard in Common Lisp? - common-lisp

I am not satisfied to find files matching a string like this:
(remove-if-not (lambda (it)
(search "wildcard" (namestring it)))
(uiop:directory-files "./"))
;; I'll ignore case with str:contains?
;; https://github.com/vindarel/cl-str
How would one search for files with unix-style wildcards ?
If it is not built-in, I'd enjoy a solution with uiop. Maybe there is with Osicat or cl-fad (with which it doesn't seem so, the documentation oftentimes says "non-wild pathname").
Bonus if it is possible to use the double wildcard to traverse directories recursively (./**/*.jpg).
edit: I have tried variants of (directory #p"./**/*.jpg") and it returns nil :( Also tried #p".*jpg", #p"./.*jpg",…
(wild-pathname-p (pathname "*.jpg"))
(:WILD :WILD-INFERIORS)
(make-pathname :name :wild :type "jpg")
#P"*.jpg"
The following gets me files by jpg extension, but it isn't a proper wildcard yet:
(directory *)
(#P"/home/vince/cl-cookbook/AppendixA.jpg"
#P"/home/vince/cl-cookbook/AppendixB.jpg"
#P"/home/vince/cl-cookbook/AppendixC.jpg")
Documentation on pathnames and make-pathname: http://gigamonkeys.com/book/files-and-file-io.html (no mentions of wildcards)

SBCL
SBCL supports wildcards in names. First, create some files:
(loop
with stem = #P"/tmp/stack/_.txt"
initially (ensure-directories-exist stem)
for name in '("abc" "def" "cadar" "cdadr" "cddr")
for path = (make-pathname :name name :defaults stem)
do (open path :direction :probe :if-does-not-exist :create))
Then, list all files that contains an "a":
CL-USER> (directory #P"/tmp/stack/*a*.txt")
(#P"/tmp/stack/abc.txt" #P"/tmp/stack/cadar.txt" #P"/tmp/stack/cdadr.txt")
The pathname contains an implementation-specific (valid) name component:
CL-USER> (describe #P"/tmp/stack/*a*.txt")
#P"/tmp/stack/*a*.txt"
[structure-object]
Slots with :INSTANCE allocation:
HOST = #<SB-IMPL::UNIX-HOST {10000F3FF3}>
DEVICE = NIL
DIRECTORY = (:ABSOLUTE "tmp" "stack")
NAME = #<SB-IMPL::PATTERN :MULTI-CHAR-WILD "a" :MULTI-CHAR-WILD>
TYPE = "txt"
VERSION = :NEWEST
; No value
SBCL also defines sb-ext:map-directory, which process files one by one, instead of first collecting all files in a list.
Portable solutions
If you need to stick to standard pathname components, you can first call directory with normal wildcards, and filter the resulting list:
CL-USER> (remove-if-not (wildcard "*a*")
(directory #P"/tmp/stack/*.txt")
:key #'pathname-name)
(#P"/tmp/stack/abc.txt" #P"/tmp/stack/cadar.txt" #P"/tmp/stack/cdadr.txt")
... where wildcard might be based on regex (PPCRE):
(defun parse-wildcard (string)
(delete ""
(map 'list
(lambda (string)
(or (cdr (assoc string
'(("*" . :wild)
("?" . :char))
:test #'string=))
string))
(ppcre:split '(:sequence
(:negative-lookbehind #\\)
(:register (:alternation #\* #\?)))
string
:with-registers-p t))
:test #'string=))
(note: the above negative lookbehind does not eliminate escaped backslashes)
(defun wildcard-regex (wildcard)
`(:sequence
:start-anchor
,#(loop
for token in wildcard
collect (case token
(:char :everything)
(:wild '(:greedy-repetition 0 nil :everything))
(t token)))
:end-anchor))
(defun wildcard (string)
(let ((scanner (ppcre:create-scanner
(wildcard-regex (parse-wildcard string)))))
(lambda (string)
(ppcre:scan scanner string))))
Intermediate functions:
CL-USER> (parse-wildcard "*a*a\\*a?\\?a")
(:WILD "a" :WILD "a\\*a" :CHAR "\\?a")
CL-USER> (wildcard-regex (parse-wildcard "*a*a\\*a?\\?a"))
(:SEQUENCE :START-ANCHOR #1=(:GREEDY-REPETITION 0 NIL :EVERYTHING) "a" #1# "a\\*a" :EVERYTHING "\\?a" :END-ANCHOR)

no current directory and no home directory characters
The concept of . denoting the current directory does not exist in portable Common Lisp. This may exist in specific filesystems and specific implementations.
Also ~ to denote the home directory does not exist. They may be recognized by some implementations as non-portable extensions.
In pathname strings you have * and ** as wildcards. This works in absolute and relative pathnames.
defaults for the default pathname
Common Lisp has *default-pathname-defaults* which provides a default for some pathname operations.
Examples
CL-USER 46 > (directory "/bin/*")
(#P"/bin/[" #P"/bin/bash" #P"/bin/cat" .... )
Now in above it is already slightly undefined or diverging what implementations do on Unix:
resolve symbolic links?
include 'hidden' files?
include files with types?
Next:
CL-USER 47 > (directory "/bin/*sh")
(#P"/bin/zsh" #P"/bin/tcsh" #P"/bin/sh" #P"/bin/ksh" #P"/bin/csh" #P"/bin/bash")
Using a relative pathname:
CL-USER 48 > (let ((*default-pathname-defaults* (pathname "/bin/")))
(directory "*sh"))
(#P"/bin/zsh" #P"/bin/tcsh" #P"/bin/sh" #P"/bin/ksh" #P"/bin/csh" #P"/bin/bash")
Files in your home directory:
CL-USER 49 > (let ((*default-pathname-defaults* (user-homedir-pathname)))
(directory "*"))
The same:
CL-USER 54 > (directory (make-pathname :name "*"
:defaults (user-homedir-pathname)))
Finding all files ending with sh in /usr/local/ and below:
CL-USER 54 > (directory "/usr/local/**/*sh")
Constructing pathnames with MAKE-PATHNAME
Three ways to find all .h files under /usr/local/:
(directory "/usr/local/**/*.h")
(directory (make-pathname :name :wild
:type "h"
:defaults "/usr/local/**/")
(directory
(make-pathname :name :wild
:type "h"
:directory '(:ABSOLUTE "usr" "local" :WILD-INFERIORS)))
Problems
There are a lot of different interpretations of implementations across platforms ('windows', 'unix', 'mac', ...) and even on the same platform (especially 'windows' or 'unix'). Stuff like unicode in pathnames creates additional complexity - not describe in the CL standard.
We still have a lot of different filesystems ( https://en.wikipedia.org/wiki/List_of_file_systems ), but they are different or different in capabilities from what was typical when Common Lisp was designed. Implementations may have tracked the changes, but not necessarily in portable ways.

Related

Clojure: How to include Resources with lein-uberjar

I want to use a changeable file in clojure-project. (Manjaro Linux & Leiningen 2.8.0 on Java 1.8.0_144 OpenJDK 64-Bit Server VM)
So, I tried ... ($ echo resources/temp.txt => Hello )
(ns test.core
(:require [clojure.java.io :refer [writer input-stream]]
[clojure.java.io :as io])
(:gen-class))
(str (io/resource ""))
(defn -main
[]
(with-open [r (input-stream (io/resource "temp.txt"))]
(loop [c (.read r)]
(if (not= c -1)
(do
(print (char c))
(recur (.read r))))))
(with-open [r (writer (.getFile (io/resource "temp.txt")))]
(.write r "See you!"))
)
and project.clj is here ...
(defproject test "0.1.0-SNAPSHOT"
:description "FIXME: write description"
:url "http://example.com/FIXME"
:license {:name "Eclipse Public License"
:url "http://www.eclipse.org/legal/epl-v10.html"}
:dependencies [[org.clojure/clojure "1.8.0"]]
:main test.core)
This program can run in lein-run
$ lein run
Hello
$
But this cannot run in lein-uberjar -> java -jar test-0.1.0-SNAPSHOT-standalone.jar
$ lein uberjar
$ java -jar test-0.1.0-SNAPSHOT-standalone.jar
Exception in thread "main" java.io.FileNotFoundException: /home/***/Documents/test/target/test-0.1.0-SNAPSHOT-standalone.jar!/temp.txt (
No such file or directory)
at java.io.FileOutputStream.open0(Native Method)
at java.io.FileOutputStream.open(FileOutputStream.java:270)
at java.io.FileOutputStream.<init>(FileOutputStream.java:213)
at clojure.java.io$fn__9522.invokeStatic(io.clj:230)
at clojure.java.io$fn__9522.invoke(io.clj:230)
at clojure.java.io$fn__9459$G__9428__9466.invoke(io.clj:69)
at clojure.java.io$fn__9526.invokeStatic(io.clj:242)
at clojure.java.io$fn__9526.invoke(io.clj:240)
at clojure.java.io$fn__9459$G__9428__9466.invoke(io.clj:69)
at clojure.java.io$fn__9534.invokeStatic(io.clj:261)
at clojure.java.io$fn__9534.invoke(io.clj:259)
at clojure.java.io$fn__9459$G__9428__9466.invoke(io.clj:69)
at clojure.java.io$fn__9496.invokeStatic(io.clj:166)
at clojure.java.io$fn__9496.invoke(io.clj:166)
at clojure.java.io$fn__9472$G__9424__9479.invoke(io.clj:69)
at clojure.java.io$writer.invokeStatic(io.clj:119)
at clojure.java.io$writer.doInvoke(io.clj:104)
at clojure.lang.RestFn.invoke(RestFn.java:410)
at test.core$_main.invokeStatic(core.clj:15)
at test.core$_main.invoke(core.clj:7)
at clojure.lang.AFn.applyToHelper(AFn.java:152)
at clojure.lang.AFn.applyTo(AFn.java:144)
at test.core.main(Unknown Source)
How do I get correct path to it?
Thank you.
One problem is that .getFile doesn't work in a jar file, because you're reading from a zip file, not a directory structure on the file system.
Also, it's not recommended to change files inside a jar file (I'm not sure it's even possible). Also see Reading a resource file from within jar.

How to use Clozure CL on IPv6 only network?

I've tried to replace SBCL with Clozure CL when working in IPv6 only network, but encountered an error like that:
MIGRATIONS> (ignore-errors (ccl:make-socket :remote-host "ya.ru" :remote-port 443))
NIL
#<CCL:NO-APPLICABLE-METHOD-EXISTS #x302005215E5D>
MIGRATIONS> (ignore-errors (ccl:make-socket :remote-host "ya.ru" :remote-port 443 :address-family :internet))
NIL
#<CCL:NO-APPLICABLE-METHOD-EXISTS #x3020052549AD>
MIGRATIONS> (ignore-errors (ccl:make-socket :remote-host "ya.ru" :remote-port 443 :address-family :internet6))
#<BASIC-TCP-STREAM ISO-8859-1 (SOCKET/16) #x3020051D4A9D>
The problem is that many libraries when using CCL:MAKE-TCP-SOCKET don't specify address-family or specify an :internet.
Is there is a way to patch ccl:make-socket at runtime to override this setting?
Advise a function
Several implementations of Common Lisp allow advising (-> patching) of normal functions. Advising is a non-standard feature and different implementations provide it in slightly different ways. A related mechanism is standardized for CLOS generic functions with :before, :after and :around methods.
The purpose is to add one or more patches to a function, after it has been defined and without altering the original source code.
Typically this requires that the function call to this function is not inlined.
The macro ADVISE in Clozure Common Lisp
Patching functions in Clozure CL can be done with the macro ADVISE. See the documentation for advising.
Let's say we have a function FOOBAR:
? (defun foobar (a b &key c (d :foobar)) (list a b c d))
FOOBAR
FOOBAR gets called inside TEST:
? (defun test (a) (foobar a 20 :c 30))
TEST
? (test 10)
(10 20 30 :FOOBAR)
We now want to patch FOOBAR such that named arg :D gets called with a different value.
We change the arglist to insert the new named argument after the two required args:
? (advise foobar (let ((arglist (list* (first arglist)
(second arglist)
:d :ipv6
(cddr arglist))))
(:do-it)) ; calling the original function
:when :around ; advise around it
:name :ipv6) ; the name of this advise
#<Compiled-function (CCL::ADVISED 'FOOBAR) (Non-Global) #x3020010D1CCF>
Now we can call our TEST function and it will call the advised function FOOBAR.
? (test 10)
(10 20 30 :IPV6)
Advise for CCL:MAKE-SOCKET
You could write a similar advise for CCL:MAKE-SOCKET.
Untested:
(advise ccl:make-socket (let ((arglist (list* :address-family
:internet6
arglist)))
(:do-it))
:when :around
:name :internet6)
This can be done!
First make a copy of the original make-socket
(IN-PACKAGE :ccl)
(DEFPARAMETER original-make-socket #'make-socket)
Then redefine make-socket. Note: You will have to provide the full spec for all keyword parameters. As it is, I've used only the ones from your question for demonstration.
(defun make-socket (&key (remote-host "defau.lt")
(remote-port 443)
(address-family :internet6))
(declare (ignore address-family))
(format t "Calling new make-socket with address-family as internet6!")
(funcall original-make-socket
:remote-host remote-host
:remote-port remote-port
:address-family :internet6))
This will signal a continuable error.
Type :go at the repl to continue.
This will successfully patch make-socket.
Now any calls to make-socket will be to the new definition. Try:
(IN-PACKAGE :cl-user)
(ccl:make-socket :remote-host "ya.ru" :remote-port 443 :address-family :IRRELEVANT)
Another way to do it, would be to override the global variable *warn-if-redefine-kernel* before redefining make-socket.
(setf *warn-if-redefine-kernel* nil)
This will avoid the continuable error signal, and straight patch the kernel function.

ClojureScript file preloader - function or pattern to emulate promise?

I'm trying to create a file preloader within ClojureScript. My idea was a pattern like this:
(def urls (atom[]))
(def loaded-resources (atom []))
(def all-resources (promise))
(defn loading-callback []
(if (= (count urls) (count loaded-resources))
(deliver all-resources loaded-resources)))
;; fill urls array
;; start ajax-loading with loading-callback on success
So my main function could go on until it would require the resources and then wait for them, which works well in Clojure.
Unfortunately, promises don't exist in ClojureScript, so how can I work around that issue? There's promesa bringing promises to CLJS based on core.async channels, but it only allows future-like promises that wait for a single function to execute which won't suffice my needs (at least in the way I've been thinking about it yesterday...).
Any suggestions to solve this issue? Maybe use a completely different pattern? I want to keep the code as simple as possible to convince people in my team to try out CLJ/S.
EDIT:
After Alan's second idea:
(def urls (atom[]))
(def loaded-resources (atom []))
(defn loading-callback [data]
(swap! loaded-resources conj data))
(defn load! [post-loading-fn]
(add-watch loaded-resources :watch-loading
(fn [_ _ _ cur]
(if (= (count cur) (count #urls)) (post-loading-fn))))
;; init ajax loading
)
(defn init []
;; fill urls array
(load! main))
(main []
(do-terrific-stuff #loaded-resources))
Meanwhile I had tried to use core.async
(def urls (atom []))
(def loaded-resources (atom []))
(def resource-chan (chan))
(defn loading-callback [data]
(go (>! resource-chan data)))
;; fill url array from main
(load! []
;; init ajax loading
(go-loop []
(when-not (= (count #loaded-resources) (count #urls))
(swap! loaded-resources conj (<! resource-chan))
(recur)))
Not sure which version is better.
I can think of 2 approaches.
Change all-resources to another atom, initialized at nil. Poll it 2x-5x/sec until it is not nil and has the "delivered" result.
Use add-watch to register a callback function to execute when the value is changed. This takes the place of blocking until the value is delivered. It is described here: http://clojuredocs.org/clojure.core/add-watch
They show a good example:
(def a (atom {}))
(add-watch a :watcher
(fn [key atom old-state new-state]
(prn "-- Atom Changed --")
(prn "key" key)
(prn "atom" atom)
(prn "old-state" old-state)
(prn "new-state" new-state)))
(reset! a {:foo "bar"})
;; "-- Atom Changed --"
;; "key" :watcher
;; "atom" #<Atom#4b020acf: {:foo "bar"}>
;; "old-state" {}
;; "new-state" {:foo "bar"}
;; {:foo "bar"}
Assuming your load resource function returns a channel (like cljs-http/get).
In clj, all you need to do is hold on to them to do a "wait-all".
(let [cs (doall (map load-resource urls)) ;; initiate the get
... ;; other initialisation
res (map <!! cs)] ;; wait-all for the resources
(do-other-things res))
In cljs, you can accumulate the responses before you continue:
(go
(let [res (atom [])]
(doseq [c cs]
(swap! res conj (<! c)))
(do-other-things #res)))
JavaScript is a single threaded environment so there is no blocking wait.
If you wish to request multiple resources and continue iff they have all been served, I do recommend using core.async and especially pipeline-async. It has a knob to finetune the parallelism of asynchronous requests. Here is idiomatic ClojureScript code to achieve what you want:
(ns example.core
(:require [cljs.core.async :refer [chan take! put! pipeline-async]
:as async]))
(defn load-resources [urls on-resources]
(let [urls-ch (chan (count urls))
resources-ch (chan)]
;; Create pipeline:
(pipeline-async 10 ;; have at most 10 requests in flight at
;; the same time, finetune as desired
resources-ch
(fn [url done-ch]
;; Pseudo code:
(request-resource
url
(fn [loaded-resource]
(put! done-ch loaded-resource))))
urls-ch)
;; Eagerly aggregate result until results-ch closes, then call back:
(take! (async/into [] resources-ch) on-resources)
;; Start the party by putting all urls onto urls-ch
;; and then close it:
(async/onto-chan urls-ch urls)))

can't use Racket's better-monads library

I'm trying to make use of Racket's better-monads library.
I have the following program :
(module bmonads racket
(provide add)
(require functional/better-monads)
(define (add)
(mlet* ((x 10)
(y 11))
(+ x y))))
When I try to load this file into the REPL(geiser), I get the following error message :
Welcome to Racket v5.3.4.
racket#> (require (file "bmonads.rkt"))
bmonads.rkt:4:11: functional/better-monads: standard-module-name-resolver: collection not found
collection: "functional"
in collection directories:
/home/me/.racket/5.3.4/collects
/usr/share/racket/collects
/home/me/.emacs.d/geiser-0.5/scheme/racket/
in: functional/better-monads
context...:
standard-module-name-resolver
standard-module-name-resolver
/usr/share/racket/collects/racket/private/misc.rkt:87:7
racket#>
Because better-monads is part of the PLT package functional.plt, you will need to load it via PlaneT.
(require (planet "better-monads.rkt" ("toups" "functional.plt" 1 1)))
Specific documentation for loading the library: http://planet.racket-lang.org/display.ss?package=functional.plt&owner=toups
General documentation on PlaneT: http://docs.racket-lang.org/planet/Using_PLaneT.html?q=planeT&q=monand

How to translate (make-pathname :directory '(:absolute :home "directoryiwant") into absolute path

I want to be able to translate a certain directory in my homedirectory on any OS to the actual absolute path on that OS e.g. (make-pathname :directory '(:absolute :home "directoryiwant") should be translated to "/home/weirdusername/directoryiwant" on a unixlike system.
What would be the function of choice to do that? As
(directory-namestring
(make-pathname :directory '(:absolute :home "directoryiwant"))
> "~/"
does not actually do the deal.
If you need something relative to your home directory, the Common Lisp functions user-homedir-pathname and merge-pathnames can help you:
CL-USER> (merge-pathnames
(make-pathname
:directory '(:relative "directoryyouwant"))
(user-homedir-pathname))
#P"/home/username/directoryyouwant/"
The namestring functions (e.g., namestring, directory-namestring) work on this pathname as expected:
CL-USER> (directory-namestring
(merge-pathnames
(make-pathname
:directory '(:relative "directoryyouwant"))
(user-homedir-pathname)))
"/home/username/directoryyouwant/"
CL-USER > (make-pathname :directory (append (pathname-directory
(user-homedir-pathname))
(list "directoryiwant"))
:defaults (user-homedir-pathname))
#P"/Users/joswig/directoryiwant/"
The function NAMESTRING returns it as a string.
CL-USER > (namestring #P"/Users/joswig/directoryiwant/")
"/Users/joswig/directoryiwant/"

Resources