Skip to content

Commit

Permalink
wip
Browse files Browse the repository at this point in the history
  • Loading branch information
athos committed Feb 6, 2024
1 parent 7228150 commit 4eadd5b
Show file tree
Hide file tree
Showing 3 changed files with 35 additions and 38 deletions.
48 changes: 21 additions & 27 deletions src/cljam/io/cram/decode/data_series.clj
Original file line number Diff line number Diff line change
@@ -1,7 +1,8 @@
(ns cljam.io.cram.decode.data-series
{:clj-kondo/ignore [:missing-docstring]}
(:require [cljam.io.cram.itf8 :as itf8]
[cljam.io.util.byte-buffer :as bb])
[cljam.io.util.byte-buffer :as bb]
[clojure.string :as str])
(:import [java.nio Buffer ByteBuffer]))

(defn- data-series-type [ds]
Expand Down Expand Up @@ -48,8 +49,11 @@
(fn []
(.mark ^Buffer block)
(let [start (.position block)
end (do (while (not= (.get block) (byte stop-byte)))
(.position block))
end (long
(loop []
(if (= (.get block) (byte stop-byte))
(.position block)
(recur))))
len (dec (- end start))
_ (.reset ^Buffer block)
ret (bb/read-bytes block len)]
Expand Down Expand Up @@ -84,26 +88,11 @@
(aset arr i (byte b))))
arr))
\B (fn [^ByteBuffer bb]
(let [tag-type' (.get bb)
(let [tag-type' (char (.get bb))
len (.getInt bb)
coercer (tag-value-coercer tag-type')]
(case (char tag-type')
(\c \C) (let [arr (byte-array len)]
(dotimes [i len]
(aset arr i (byte (coercer bb))))
arr)
(\s \S) (let [arr (short-array len)]
(dotimes [i len]
(aset arr i (short (coercer bb))))
arr)
(\i \I) (let [arr (int-array len)]
(dotimes [i len]
(aset arr i (int (coercer bb))))
arr)
(\f) (let [arr (float-array len)]
(dotimes [i len]
(aset arr i (float (coercer bb))))
arr))))))
coercer (tag-value-coercer tag-type')
vs (repeatedly len (partial coercer bb))]
(str/join \, (cons tag-type' vs))))))

(defn- build-tag-decoder [tag-encoding tag-type content-id->block-data]
(let [decoder (build-codec-decoder tag-encoding :bytes content-id->block-data)
Expand All @@ -114,8 +103,13 @@

(defn build-tag-decoders [{:keys [tags]} blocks]
(let [content-id->block-data (into {} (map (juxt :content-id :data)) blocks)]
(reduce-kv (fn [decoders tag {tag-type :type :keys [encoding]}]
(let [decoder (build-tag-decoder encoding tag-type content-id->block-data)
tag-type' (str (if (#{\c \C \s \S \i \I} tag-type) \i tag-type))]
(assoc decoders tag (fn [] {:type tag-type' :value (decoder)}))))
{} tags)))
(reduce-kv
(fn [decoders tag m]
(reduce-kv
(fn [decoders tag-type encoding]
(let [decoder (build-tag-decoder encoding tag-type content-id->block-data)
tag-type' (str (if (#{\c \C \s \S \i \I} tag-type) \i tag-type))]
(assoc-in decoders [tag tag-type]
(fn [] {:type tag-type' :value (decoder)}))))
decoders m))
{} tags)))
19 changes: 11 additions & 8 deletions src/cljam/io/cram/decode/record.clj
Original file line number Diff line number Diff line change
Expand Up @@ -51,16 +51,19 @@
(assoc ::next-fragment (NF)))))))

(defn- build-auxiliary-tags-decoder [{:keys [preservation-map]} {:keys [TL]} tag-decoders]
(let [tag-dict (:TD preservation-map)]
(let [tag-decoder (fn [{tag-type :type :keys [tag]}]
(let [decoder (get-in tag-decoders [tag tag-type])]
(fn []
{tag (decoder)})))
decoders (mapv (fn [tags]
(let [decoders (mapv tag-decoder tags)]
(fn []
(into [] (map #(%)) decoders))))
(:TD preservation-map))]
(fn [record]
(let [tl (TL)
tags (nth tag-dict tl)]
(->> tags
(reduce (fn [acc {:keys [tag]}]
(let [decoder (get tag-decoders tag)]
(conj acc {tag (decoder)})))
[])
(assoc record :options))))))
decoder (nth decoders tl)]
(assoc record :options (decoder))))))

(defn- record-seq
[seq-resolver {:keys [preservation-map]} {:keys [rname pos end] :as record} features]
Expand Down
6 changes: 3 additions & 3 deletions src/cljam/io/cram/decode/structure.clj
Original file line number Diff line number Diff line change
Expand Up @@ -173,16 +173,16 @@
(defn- decode-tag-encoding-map [bb]
(let [_size (itf8/decode-itf8 bb)
n (itf8/decode-itf8 bb)]
(loop [i n, acc (transient {})]
(loop [i n, acc {}]
(if (zero? i)
(persistent! acc)
acc
(let [k (itf8/decode-itf8 bb)
c1 (char (bit-and (bit-shift-right k 16) 0xff))
c2 (char (bit-and (bit-shift-right k 8) 0xff))
t (char (bit-and k 0xff))
v (decode-encoding bb)
tag (keyword (str c1 c2))]
(recur (dec i) (assoc! acc tag {:type t :encoding v})))))))
(recur (dec i) (assoc-in acc [tag t] v)))))))

(defn decode-compression-header-block [bb]
(let [{bb' :data} (decode-block bb)
Expand Down

0 comments on commit 4eadd5b

Please sign in to comment.