(defn make-fat-chain [start length]
  (let [start (inc start)
        end (+ start (dec length))]
    (conj (vec (range start end)) ENDOFCHAIN)))

(defn make-proto-fat [sizes]
  (reduce (fn [[starts fat] size]
            (let [starts (conj starts (count fat))
                  chain (make-fat-chain (count fat) (calc-num-sector size))
                  fat (concat fat chain)]
              [starts fat]))
          [[] []] sizes))

(defn calc-num-sector
  ([length] (calc-num-sector length 1))
  ([length entry-size]
   (let [total-size (* length entry-size)
         num-full-sector (math/floor-div total-size SectorSize)]
     (if (zero? (mod total-size SectorSize))
       num-full-sector
       (inc num-full-sector)))))

(defn calc-num-difat-sector [num-fat-sector]
  (if (<= num-fat-sector difat-entry-in-header)
    0
    (let [num-full-sector (math/floor-div (- num-fat-sector difat-entry-in-header) 127)]
      (if (zero? (mod (- num-fat-sector difat-entry-in-header) 127))
        num-full-sector
        (inc num-full-sector)))))

(def fat-entry-peer-sector (/ SectorSize u32size))

(defn make-fat [proto-fat]
  (loop [num-fat-sector (calc-num-sector (count proto-fat) u32size)
         num-difat-sector (calc-num-difat-sector num-fat-sector)]
    (if (> (+ num-fat-sector (count proto-fat) num-difat-sector)
           (* num-fat-sector fat-entry-peer-sector))
      (recur (inc num-fat-sector)
             (calc-num-difat-sector (inc num-fat-sector)))
      (let [num-total-fat-entry (* num-fat-sector fat-entry-peer-sector)
            num-used-fat-entry (+ num-fat-sector (count proto-fat) num-difat-sector)
            num-pad-entry (- num-total-fat-entry num-used-fat-entry)
            start (+ (count proto-fat) num-difat-sector num-pad-entry)
            start-difat (if (zero? num-difat-sector)
                          ENDOFCHAIN
                          (count proto-fat))]
        [(concat proto-fat
                 (long-array num-difat-sector DIFATSEC)
                 (long-array num-pad-entry FREESEC)
                 (long-array num-fat-sector FATSEC))
         start num-fat-sector start-difat num-difat-sector num-pad-entry]))))

(defn add-node [directory parent-id direction node]
  (let [new-id (count directory)
        parent-node (nth directory parent-id)
        upd-parent-node (assoc parent-node direction new-id)]
    [(conj (assoc directory parent-id upd-parent-node) node)
     new-id]))

(defn insert-in-tree [directory root-id node]
  (loop [root-id root-id
         parent-id nil
         direction nil]
    (if (nil? root-id)
      (add-node directory parent-id direction node)
      (let [{:keys [name left right]} (directory root-id)
            cmp-res (compare (:name node) name)]
        (cond
          (< cmp-res 0) (recur left root-id :left)
          (> cmp-res 0) (recur right root-id :right)
          :else [directory root-id])))))

(defn insert-in-storage [directory storage-id node]
  (let [storage (nth directory storage-id)
        root-id (:child storage)]
    (if (nil? root-id)
      (add-node directory storage-id :child node)
      (insert-in-tree directory root-id node))))(defn insert-in-storage 

(defrecord Node [name child left right type size start])

(defn add-nodes-path [directory path]
  (let [[directory _] (reduce (fn [[directory storage-id] node]
                                (insert-in-storage directory storage-id node))
                              [directory 0] path)]
    directory))

(defn make-nodes-path [path size start]
  (let [path* (string/split path #"/")
        head (map #(map->Node {:name % :type StorageObject}) (drop-last path*))
        tail (map->Node {:name (last path*) :type StreamObject :size size :start start})]
    (concat head (list tail))))

(defn make-directory [items]
  (reduce (fn [directory [path size start]]
            (let [path* (make-nodes-path path size start)]
              (add-nodes-path directory path*)))
          [(map->Node {:name "Root Entry" :type RootStorageObject})] items))

(defn make-difat-head [start length]
  {:pre [(<= length difat-entry-in-header)]}
  (concat (range start (+ start length))
          (long-array (- difat-entry-in-header length) FREESEC)))

(defn make-difat-tail [start-fat length start-difat]
  (let [arr (range start-fat (+ start-fat length))
        pad (long-array (calc-padding length 127) FREESEC)
        num-difat-sector (calc-num-difat-sector (+ length difat-entry-in-header))
        [res _ _] (->> (concat arr pad)
                       (partition 127)
                       (reduce (fn [[res current-difat-sector remaing] part]
                                 (let [next-difat-sector (if (zero? remaing)
                                                           ENDOFCHAIN
                                                           (inc current-difat-sector))]
                                   [(concat res part [next-difat-sector])
                                    (inc current-difat-sector)
                                    (dec remaing)]))
                               [[] start-difat (dec num-difat-sector)]))]
    res))

(defn make-difat [start-fat length start-difat]
  (let [head-length (min length difat-entry-in-header)
        tail-length (if (< length difat-entry-in-header)
                      0
                      (- length difat-entry-in-header))]
    [(make-difat-head start-fat head-length)
     (make-difat-tail (+ start-fat difat-entry-in-header) tail-length start-difat)]))

(defn serialize-header [header]
  (let [^ByteBuffer buffer (ByteBuffer/allocate SectorSize)]
    (doto buffer
      (.order ByteOrder/LITTLE_ENDIAN)
      (.put (byte-array [0xD0 0xCF 0x11 0xE0 0xA1 0xB1 0x1A 0xE1])) ; Signature
      (.put (byte-array 16 (byte 0)))      ; CLSID
      (.putShort 0x003E)                   ; Minor version
      (.putShort 0x0003)                   ; Major version
      (.putShort (unchecked-short 0xFFFE)) ; Byte order
      (.putShort 0x0009)                   ; Sector size
      (.putShort 0x0006)                   ; Mini stream sector size
      (.putShort 0)                        ; Reserved
      (.putInt 0)                          ; Reserved
      (.putInt 0) ; Number of directory sector (not used for version 3)
      (.putInt (:num-fat-sector header)) ; Number of FAT sector
      (.putInt (:start-directory header)) ; Directory starting sector location
      (.putInt 0)                         ; Transaction signature
      (.putInt 0)                         ; Mini stream cutoff
      (.putInt (unchecked-int ENDOFCHAIN)) ; Mini FAT start sector location
      (.putInt 0)                          ; Number of mini FAT sector
      (.putInt (unchecked-int (:start-difat-sector header))) ; DIFAT start sector location
      (.putInt (:num-difat-sector header)))  ; Number of DIFAT sector
    (doseq [entry (:difat-head header)]
      (.putInt buffer (unchecked-int entry)))
    (.array buffer)))

(defn nil->default [default value]
  (if (nil? value) default value))

(def nil->0xFFFFFFFF (partial nil->default 0xFFFFFFFF))
(def nil->0 (partial nil->default 0))

(defn serialize-directory-entry [entry]
  (let [^ByteBuffer buffer (ByteBuffer/allocate DirectoryEntrySize)
        name (.getBytes (:name entry) "UTF-16LE")
        name-size (if (empty? name) 0 (+ (count name) 2))]
    (doto buffer
      (.order ByteOrder/LITTLE_ENDIAN)
      (.put name)
      (.putShort 0)                   ; Entry name terminator
      (.put (byte-array (- 64 (+ (count name) 2)) (byte 0))) ; Entry name padding
      (.putShort name-size) ; Entry name length with terminator
      (.put (:type entry))
      (.put (byte 0x01))             ; Color flag - black
      (.putInt (unchecked-int (nil->0xFFFFFFFF (:left entry))))
      (.putInt (unchecked-int (nil->0xFFFFFFFF (:right entry))))
      (.putInt (unchecked-int (nil->0xFFFFFFFF (:child entry))))
      (.put (byte-array 16 (byte 0x00))) ; CLSID
      (.putInt 0)                        ; State bits
      (.putLong 0)                       ; Creation time
      (.putLong 0)                       ; Modified time
      (.putInt (unchecked-int (nil->0 (:start entry))))
      (.putLong (unchecked-long (nil->0 (:size entry)))))
    (.array buffer)))

(defn serialize-int-array [fat]
  (let [^ByteBuffer buffer (ByteBuffer/allocate (* (count fat) u32size))]
    (.order buffer ByteOrder/LITTLE_ENDIAN)
    (doseq [entry fat]
      (.putInt buffer (unchecked-int entry)))
    (.array buffer)))

(defn make-cfb [output-path streams]
  (let [[starts strm-proto-fat] (make-proto-fat (map (comp count last) streams))
        directory (make-directory (map (fn [[path stream] start]
                                         [path (count stream) start]) streams starts))
        start-directory (count strm-proto-fat)
        num-directory-sector (calc-num-sector (count directory) DirectoryEntrySize)
        proto-fat (concat strm-proto-fat
                          (make-fat-chain start-directory num-directory-sector))
        [fat start-fat num-fat-sector
         start-difat num-difat-sector num-pad-sector] (make-fat proto-fat)
        [difat-head difat-tail] (make-difat start-fat num-fat-sector start-difat)
        header {:num-fat-sector num-fat-sector
                :start-directory start-directory
                :start-difat-sector start-difat
                :num-difat-sector num-difat-sector
                :difat-head difat-head}]

    (with-open [out (io/output-stream output-path)]
      (.write out (serialize-header header))
      (doseq [[_ content] streams]
        (.write out content)
        (.write out (byte-array (calc-padding (count content)) (byte 0))))
      (doseq [entry directory]
        (.write out (serialize-directory-entry entry)))
      (doseq [_ (range (calc-padding (count directory) DirectoryEntryPeerSector))]
        (.write out (serialize-directory-entry (map->Node {:name "" :type (byte 0x00)}))))
      (.write out (serialize-int-array difat-tail))
      (doseq [_ (range num-pad-sector)]
        (.write out (byte-array SectorSize (byte 0))))
      (.write out (serialize-int-array fat)))))

(defn read-u8! [^ByteBuffer buffer]
  (-> buffer
      .get
      (bit-and 0xFF)))

(defn read-u16! [^ByteBuffer buffer]
  (-> buffer
      .getShort
      (bit-and 0xFFFF)))

(defn read-u32! [^ByteBuffer buffer]
  (-> buffer
      .getInt
      (bit-and 0xFFFFFFFF)))

(defn shift-position! [^ByteBuffer buffer n]
  (.position buffer (+ (.position buffer) n)))

(defn read-header! [^FileChannel f]
  (let [buffer (ByteBuffer/allocate HeaderSize)
        signature (byte-array 8)]
    (.read f buffer)
    (doto buffer
      (.order ByteOrder/LITTLE_ENDIAN)
      (.rewind)
      (.get signature))
    (assert (java.util.Arrays/equals signature
                                     (byte-array [0xD0 0xCF 0x11 0xE0 0xA1 0xB1 0x1A 0xE1])))
    (shift-position! buffer 16) ; Skip CLSID
    (let [header (apply hash-map [:minor-version (read-u16! buffer)
                                  :major-version (read-u16! buffer)
                                  :byte-order (read-u16! buffer)
                                  :sector-shift (read-u16! buffer)
                                  :mini-sector-shift (read-u16! buffer)
                                  :num-fat-sector (do ; skip reserved and numdirectory sector
                                                    (shift-position! buffer 10)
                                                    (read-u32! buffer))
                                  :start-directory-sector (read-u32! buffer)
                                  :mini-stream-cutoff (do ; skip transaction signature
                                                        (shift-position! buffer 4)
                                                        (read-u32! buffer))
                                  :start-minifat (read-u32! buffer)
                                  :num-minifat-sector (read-u32! buffer)
                                  :start-difat-sector (read-u32! buffer)
                                  :num-difat-sector (read-u32! buffer)])

          difat (let [difat (transient [])]
                  (doseq [_ (range (min (:num-fat-sector header) 109))]
                    (conj! difat (read-u32! buffer)))
                  (persistent! difat))]

      (assert (= (:minor-version header) 0x003E))
      (assert (= (:major-version header) 0x0003))
      (assert (= (:byte-order header) 0xFFFE))
      (assert (= (:sector-shift header) 0x0009))
      (assoc header :difat difat))))

(defn sector->offset [n]
  (* (+ n 1) SectorSize))

(defn read-difat-tail [f difat-sector]
  (if (= difat-sector ENDOFCHAIN)
    []
    (let [^ByteBuffer buffer (ByteBuffer/allocate SectorSize)
          res (transient [])]
      (.order buffer ByteOrder/LITTLE_ENDIAN)
      (.position f (sector->offset difat-sector))
      (.read f buffer)
      (.rewind buffer)
      (doseq [_ (range 127)]
        (conj! res (read-u32! buffer)))
      (concat (persistent! res) (read-difat-tail f (read-u32! buffer))))))

(defn read-fat [^FileChannel f difat num-fat-sector]
  (let [^ByteBuffer buffer (ByteBuffer/allocate SectorSize)
        fat (transient [])]
    (.order buffer ByteOrder/LITTLE_ENDIAN)
    (loop [remaing num-fat-sector
           difat difat]
      (let [sector (first difat)]
        (.position f (sector->offset sector))
        (.clear buffer)
        (.read f buffer)
        (.rewind buffer)
        (doseq [_ (range (/ SectorSize u32size))]
          (conj! fat (read-u32! buffer)))
        (if (> remaing 1)
          (recur (dec remaing) (rest difat)))))
    (persistent! fat)))

(defn read-directory-entry-name! [^ByteBuffer buffer]
  (let [name (byte-array 64 (byte 0x00))]
    (.get buffer name)
    (let [len (read-u16! buffer)]
      (if (> len 0)
        (String. name 0 (- len 2) "UTF-16LE")
        (String.)))))

(defn read-directory-entry-type! [^ByteBuffer buffer]
  (let [type (read-u8! buffer)]
    (case type
      1 :storage
      2 :stream
      5 :root
      :unknown)))

(defn read-directory-sector! [^FileChannel f sector]
  (let [buffer (ByteBuffer/allocate 128)
        entries (transient [])]
    (.order buffer ByteOrder/LITTLE_ENDIAN)
    (.position f (sector->offset sector))
    (doseq [_ (range DirectoryEntryPeerSector)]
      (.clear buffer)
      (.read f buffer)
      (.rewind buffer)
      (let [entry (apply hash-map [:name (read-directory-entry-name! buffer)
                                   :type (read-directory-entry-type! buffer)
                                   :color (read-u8! buffer)
                                   :left (read-u32! buffer)
                                   :right (read-u32! buffer)
                                   :child (read-u32! buffer)
                                   :start (do (shift-position! buffer (+ 16 ; CLSID
                                                                         4 ; State bits
                                                                         8 ; Creation time
                                                                         8)) ; Modified time
                                              (read-u32! buffer))
                                   :size (read-u32! buffer)])]
        (conj! entries entry)))
    (persistent! entries)))

(defn read-directory-stream! [^FileChannel file fat start]
  (let [entries (transient [])]
    (loop [sector start]
      (if (= sector ENDOFCHAIN)
        (persistent! entries)
        (do
          (doseq [entry (read-directory-sector! file sector)]
            (conj! entries entry))
          (recur (nth fat sector)))))))

(defn parse-directory-stream
  ([directory-stream] (parse-directory-stream directory-stream 0))
  ([directory-stream root-id]
   (if (= root-id NOSTREAM)
     {}
     (let [obj (nth directory-stream root-id)
           entry (if (or (= (:type obj) :storage)
                         (= (:type obj) :root))
                   (merge {:type :storage} (parse-directory-stream directory-stream (:child obj)))
                   (select-keys obj [:type :start :size]))]
       (merge {(:name obj) entry}
              (parse-directory-stream directory-stream (:left obj))
              (parse-directory-stream directory-stream (:right obj)))))))

(defn locate-first-sector [fat start offset]
  (loop [start start
         offset offset]
    (if (>= offset SectorSize)
      (recur (nth fat start)
             (- offset SectorSize))
      start)))

(defprotocol CFBStreamProtocol
  (read-stream [this] [this length] [this offset length]))

(deftype CFBStream [file fat start stream-size]
  CFBStreamProtocol
  (read-stream [this] (read-stream this 0 stream-size))
  (read-stream [this length] (read-stream this 0 length))
  (read-stream [this offset length]
    (let [result-buffer (byte-array length (byte 0))]
      (loop [result-buffer-pos 0
             remaing length
             sector (locate-first-sector fat start offset)
             offset (mod offset SectorSize)]
        (when (> remaing 0)
          (let [read-length (- (min remaing SectorSize) offset)
                fbuf (ByteBuffer/allocate read-length)]
            (.position file (+ (sector->offset sector) offset))
            (.read file fbuf)
            (.rewind fbuf)
            (.get fbuf result-buffer result-buffer-pos read-length)
            (recur (+ result-buffer-pos read-length)
                   (- remaing read-length)
                   (nth fat sector)
                   0))))
      result-buffer)))

(defprotocol CFBProtocol
  (open-stream [this path]))

(deftype CFB [file header fat directory]
  CFBProtocol
  (open-stream [this path]
    (let [p (string/split (str "Root Entry/" path) #"/")
          {:keys [start size]} (get-in directory p)]
      (CFBStream. file fat start size))))

(defn open-cfb [^String path]
  (let [p (Paths/get path (into-array String []))
        file (FileChannel/open p (into-array OpenOption [StandardOpenOption/READ]))
        header (read-header! file)
        difat (concat (:difat header) (read-difat-tail file (:start-difat-sector header)))
        fat (read-fat file difat (:num-fat-sector header))
        directory-stream (read-directory-stream! file fat (:start-directory-sector header))
        directory (parse-directory-stream directory-stream)]
    (CFB. file header fat directory)))

(defn dump-header [^String path]
  (let [p (Paths/get path (into-array String []))
        file (FileChannel/open p (into-array OpenOption [StandardOpenOption/READ]))]
    (read-header! file)))