-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathutil.lisp
204 lines (182 loc) · 7.63 KB
/
util.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
;;;; util.lisp
(in-package #:harlie)
(defun string-strip-surrounding-whitespace (str)
"Strip whitespace characters from beginning and end of a string."
(string-trim '(#\Space #\Newline #\Return #\Tab) str))
(defun strip-spaces (strings)
"remove book-end whitespace from a string or list of strings."
(cond
((listp strings) (mapcar #'string-strip-surrounding-whitespace strings))
(t (string-strip-surrounding-whitespace strings))))
(defun cleanup-title (title)
"Remove extraneous whitespace characters from within and around a string.
Specifically: split the string on newlines; strip leading and trailing
whitespace from each substring; drop empty substrings; compose a new string
from the remaining substrings, with single-space separators."
(if title
(format nil "~{~A~^ ~}"
(remove-if #'(lambda (s)
(string= "" s))
(strip-spaces
(split-sequence #\Newline title))))
nil))
(defun float-as-string-p (fstring)
"Is fstring a floating point number encoded as a string?"
(let ((scanner (create-scanner "^[0-9]*([.][0-9]*)?$")))
(cl-ppcre:scan scanner fstring)))
(defun break-on-no-break-space (zert)
"break up a string or list of strings by #\NO-BREAK_SPACE; these
types of string are returned by our find-forex function as encoded
at xe.com."
(if (listp zert)
(loop for string in zert
:collect (split-sequence:split-sequence #\NO-BREAK_SPACE string))
(split-sequence:split-sequence #\NO-BREAK_SPACE zert)))
;;;============================================================================
;;; stock market stuff
;;;============================================================================
(defclass stock ()
((stock-name
:initarg :stock-name
:initform (error "A stock object must have a name. Please supply one.")
:accessor stock-name)
(stock-freshness
:initarg :stock-freshness
:initform nil
:accessor stock-freshness)
(stock-open
:initarg :stock-open
:initform (error "Must supply an opening price.")
:accessor stock-open)
(stock-high
:initarg :stock-high
:initform (error "Must supply a high price for the day.")
:accessor stock-high)
(stock-low
:initarg :stock-low
:initform (error "Must supply a low price for the day.")
:accessor stock-low)
(stock-close
:initarg :stock-close
:initform nil
:accessor stock-close)
(stock-volume
:initarg :stock-volume
:initform nil
:accessor stock-volume)))
(defun jget (obj string-thing)
"jsown is the worst name ever."
(jsown:val obj string-thing))
(defun make-stock (name &key (function "TIME_SERIES_DAILY") (when (date-time:now)))
(handler-case
(let* ((raw-data (get-stock-values name :function function))
(tradedays (list "Mon" "Tue" "Wed" "Thu" "Fri"))
(rundate (simple-date-time:YYYY-MM-DD when))
(stock-info ;; (jget (jget raw-data "Time Series (Daily)") rundate)
(cond
((find (simple-date-time:day-name-of when) tradedays :test #'string-equal)
(jget (jget raw-data "Time Series (Daily)") rundate))
(t (error "Market is closed today.")))
)
(metadata (jget raw-data "Meta Data"))
(name (jget metadata "2. Symbol"))
(freshness (date:parse-time (jget metadata "3. Last Refreshed")))
(open (jget stock-info "1. open"))
(high (jget stock-info "2. high"))
(low (jget stock-info "3. low"))
(close (jget stock-info "4. close"))
(volume (jget stock-info "5. volume")))
(make-instance 'stock
:stock-name name
:stock-freshness freshness
:stock-open (parse-number open)
:stock-high (parse-number high)
:stock-low (parse-number low)
:stock-close (parse-number close)
:stock-volume (parse-number volume)))
(error (se)
;;(declare (ignorable se))
;; (break)
(format t "Error: ~A~2%" se)
)))
;; (jsown:val (jsown:val (get-stock-values "IBM" :function "TIME_SERIES_INTRADAY") "Time Series (1min)") "2017-11-02 15:00:00")
;; (jdown:val (jsown:val (get-stock-values "IBM") "Time Series (Daily)") (simple-date-time:YYYY-MM-DD (date-time:now)))
(defun get-stock-values (stock &key (function "TIME_SERIES_DAILY"))
"take a stock symbol, look it up using the alphavantage.co api, and
return a list of the values encoded in the resulting JSON object."
(let* ((data-source (cond
((string-equal function "TIME_SERIES_DAILY_ADJUSTED")
(format nil "~A~A~A~A~A"
"https://www.alphavantage.co/query?function="
function
"&symbol="
stock
;; "&outputsize=full"
"&apikey=JMRFD5OZA2QQGJKU"))
((string-equal function "TIME_SERIES_INTRADAY")
(format nil "~A~A~A~A~A~A"
"https://www.alphavantage.co/query?function="
function
"&symbol="
stock
"&interval=1min"
"&apikey=JMRFD5OZA2QQGJKU"))
(t
(format nil "~A~A~A~A~A"
"https://www.alphavantage.co/query?function="
function
"&symbol="
stock
;; "&outputsize=full"
"&apikey=JMRFD5OZA2QQGJKU"))))
(quote (strip-spaces
(flexi-streams:octets-to-string
(drakma:http-request
data-source)
:external-format :utf-8))))
;; (format t "~A"data-source)
(assert quote)
(jsown:parse quote)))
(defun make-url-prefix (server-name server-port)
"Compose the portion of an URL encoding the server name and server port."
(if (eql 80 server-port)
(format nil "http://~A/"
server-name)
(format nil "http://~A:~A/"
server-name
server-port)))
(defun make-pathname-in-homedir (fname)
"Return a pathname relative to the user's home directory."
(merge-pathnames
fname
(make-pathname :directory
(pathname-directory
(user-homedir-pathname)))))
(defun make-pathname-in-lisp-subdir (fname)
"Return a pathname relative to the Lisp source code subtree in the user's home directory."
(merge-pathnames
fname
(make-pathname-in-homedir "SourceCode/lisp/")))
(defun create-caseless-scanner (s)
(create-scanner s :case-insensitive-mode t))
(defun scan-to-substrings (rx s)
(multiple-value-bind (whole parts) (scan-to-strings rx s)
(declare (ignore whole))
parts))
(defun timestamp-diff (t1 t2)
"Find the difference, in seconds, between two timestamps."
(abs (- (timestamp-to-universal t1) (timestamp-to-universal t2))))
(defun unix-pathstring-from-pathname (pn)
(let* ((pnt (pathname-type pn))
(extension (if pnt (format nil ".~A" pnt) ""))
(pnn (pathname-name pn))
(pnd (cdr (pathname-directory pn)))
(pc (if pnn
(append pnd (list pnn))
pnd)))
(format nil "/~{~A~^/~}~A" pc extension)))
(defun de-utm-url (url)
(let ((utm-index (scan "[&?][uU][tT][mM]_|[&?][mM][bB][iI][dD]" url)))
(if utm-index
(subseq url 0 utm-index)
url)))