1 files changed, 146 insertions, 0 deletions
diff --git a/test/types.scm b/test/types.scm
new file mode 100644
index 0000000..d886b2f
--- /dev/null
+++ b/test/types.scm
@@ -0,0 +1,146 @@
+(use-modules (ibkr types)
+	     (json)
+	     (ice-9 textual-ports)
+	     (srfi srfi-1)
+	     (srfi srfi-43)
+	     (srfi srfi-64))
+
+(define (read-text path)
+  (call-with-input-file path (lambda (p) (get-string-all p))))
+
+(test-begin "json->type-list")
+(let* ((text (read-text "test/account-response.json"))
+       (arr (json-string->scm text)))
+  (test-assert "arr-is-vector" (vector? arr))
+  (let ((res (json->type-list scm->account text)))
+    (test-assert "res-is-list" (list? res))
+    (test-assert "res-is-typed" (account? (car res)))))
+(test-end "json->type-list")
+
+(test-begin "auth-status")
+(let ((auth (json->auth-status (read-text "test/auth-response.json"))))
+  (test-assert "connected" (auth-status-connected auth)))
+(test-end "auth-status")
+
+(test-begin "account")
+(let ((accts (json->type-list
+	      scm->account (read-text "test/account-response.json"))))
+  (test-equal "length" 1 (length accts))
+  (let ((acct (car accts)))
+    (test-equal "id" "U1234567" (account-id acct))
+    (test-equal "type" "DEMO" (account-type acct))))
+(test-end "account")
+
+(test-begin "position")
+(let* ((positions
+	(json->type-list
+	 scm->position (read-text "test/position-response.json")))
+       (hd (car positions)))
+  (test-equal "contract-id" 756733 (position-contract-id hd))
+  (test-approximate "quantity" 5.0 (position-quantity hd) 1e-6))
+(test-end "position")
+
+(test-begin "ledger")
+(let* ((scm (json-string->scm (read-text "test/ledger-response.json")))
+       (usd (scm->ledger (assoc-ref scm "USD"))))
+  (test-equal "cash-balance" 214716688 (ledger-cash-balance usd))
+  (test-equal "currency" "USD" (ledger-currency usd)))
+(test-end "ledger")
+
+(test-begin "contract")
+(let* ((scm (json-string->scm (read-text "test/stocks-response.json")))
+       (stocks (assoc-ref scm "AAPL"))
+       (stock (vector-ref stocks 0))
+       (contracts (assoc-ref stock "contracts"))
+       (contract (scm->contract (vector-ref contracts 0))))
+  (test-equal "contract-id" 265598 (contract-id contract))
+  (test-equal "exchange" "NASDAQ" (contract-exchange contract))
+  (test-equal "exchange-in-usa" #t (contract-exchange-in-usa contract)))
+(test-end "contract")
+
+(test-begin "stock")
+(let* ((scm (json-string->scm (read-text "test/stocks-response.json")))
+       (stocks (assoc-ref scm "AAPL"))
+       (stock (scm->stock (vector-ref stocks 0)))
+       (contracts (stock-contracts stock))
+       (contract (car contracts)))
+  (test-equal "name" "APPLE INC" (stock-name stock))
+  (test-equal "length" 3 (length contracts))
+  (test-assert "contract-type" (contract? contract))
+  (test-assert "list-type" (list? contracts)))
+(test-end "stock")
+
+(test-begin "snapshot")
+(test-equal "last-trade" 31 (snapshot-field 'last-trade))
+(test-equal "last-trade" #f (snapshot-field 'foobar))
+(test-end "snapshot")
+
+(test-begin "order")
+(let ((ord (json->order (read-text "test/order-example.json"))))
+  (test-equal "account-id" "U1234567" (order-account-id ord))
+  (test-equal "contract-id" 265598 (order-contract-id ord))
+  (test-equal "type" "TRAILLMT" (order-type ord))
+  (test-equal "side" "BUY" (order-side ord)) ; "BUY" or "SELL"
+  (test-equal "time-in-force" "GTC" (order-time-in-force ord))
+  (test-equal "quantity" 100 (order-quantity ord)))
+(test-end "order")
+
+(test-begin "order-reply")
+(let* ((lst (json->type-list json->order-reply
+			     (read-text "test/order-reply-response.json")))
+       (reply (car lst)))
+  (test-equal "order-id" "1234567890" (order-reply-order-id reply))
+  (test-equal "status" "Submitted" (order-reply-status reply))
+  (test-equal "encrypted" "1" (order-reply-encrypted reply)))
+(test-end "order-reply")
+
+(test-begin "order-warning")
+(let* ((lst (json->type-list json->order-warning
+			     (read-text "test/order-warning-response.json")))
+       (warning (car lst)))
+  (test-equal "id" "07a13a5a-4a48-44a5-bb25-5ab37b79186c"
+	      (order-warning-id warning))
+  (test-assert "message" (vector? (order-warning-message warning))) ; of strings
+  (test-equal "suppressed" #f (order-warning-is-suppressed warning))
+  (test-equal "encrypted" #("o163") (order-warning-message-ids warning)))
+(test-end "order-warning")
+
+(test-begin "order-reject")
+(let* ((reject (json->order-reject
+		(read-text "test/order-reject-response.json"))))
+  (test-assert "error" (string? (order-reject-error reject))))
+(test-end "order-reject")
+
+(test-begin "order-confirmation")
+(let* ((conf (json->order-confirmation
+	      (read-text "test/order-confirmation.json"))))
+  (test-assert "confirmed" (order-confirmation-confirmed conf)))
+(test-end "order-confirmation")
+
+(test-begin "order-preview")
+(let* ((preview (json->order-preview (read-text "test/order-preview-response.json")))
+       (amt (order-preview-amount preview)))
+  (test-equal "total" "1,978.60 USD" (order-preview-amount-total amt))
+  (test-equal "commission" "1 USD" (order-preview-amount-commission amt))
+  (test-assert "warning" (string? (order-preview-warning preview))))
+(test-end "order-preview")
+
+(test-begin "order-status")
+(let ((status (json->order-status (read-text "test/order-status-response.json")))) 
+  (test-equal "order-id" 1799796559 (order-status-order-id status))
+  (test-equal "average-price" "192.26" (order-status-average-price status))
+  (test-equal "currency" "USD" (order-status-currency status))
+  (test-equal "contract-id" 265598 (order-status-contract-id status))
+  (test-equal "side" "S" (order-status-side status)) ; "B" or "S"
+  (test-equal "status" "Filled" (order-status-status status))
+  (test-equal "quantity" "5.0" (order-status-quantity status)))
+(test-end "order-status")
+
+(test-begin "json-string->order-submit-response")
+(let ((reply (read-text "test/order-reply-response.json"))
+      (warning (read-text "test/order-warning-response.json"))
+      (reject (read-text "test/order-reject-response.json")))
+  (test-assert "reply" (order-reply? (json-string->order-submit-response reply)))
+  (test-assert "warning" (order-warning? (json-string->order-submit-response warning)))
+  (test-assert "reject" (order-reject? (json-string->order-submit-response reject))))
+(test-begin "json-string->order-submit-response")