gistfile1.clj

(ns FBRest.registers.flatten_tree
  (:require [clojure.zip :as zip])
  (:require [clojure.string :as str])
  (:use [clojure.tools.logging])
  (:require [clojure.java.jdbc :as sql])  
  (:use [FBRest.registers.common :only [add-zeroes]])
)


(defn get-name-by-ref-id
  "Get name from universal reference by reference type and code"
  [ref-type ref-id]
  (debugs "get-name-by-ref-id" ref-type ref-id)
  (sql/with-query-results results 
    ["select mtrft_name 
        from MetaRefTable 
        where mtrft_type=? and mtrft_code=?" ref-type ref-id]
        (or 
          (when-first [record results] (:mtrft_name record))
          (str "Не найден код " ref-type " " ref-id))))
  

(defn code-range
  "check if code is not null and in range of (range)0000 - (range)9999"
  [code range]
  (and code 
    (= (quot code 10000) range)))


(defn get-default-smeta-name  
  "Get name for smeta row, function is called by default when no other options active"
  [{p :P acc :Acc ho :HO hpo :HPO}]
  (cond 
    (code-range hpo 92) (get-name-by-ref-id 102 hpo)
    (code-range ho 90) (get-name-by-ref-id 90 ho)
    (code-range ho 91) (get-name-by-ref-id 91 ho)
    :else (str "(default name " p " " acc " " ho " " hpo ")")
    ))


(defn check-even-attrs
  "check if attrs seq has even count of attributes. Shows warning in log" 
  [attrs path]
  (or (even? (count attrs))    
    (let [msg (str "ERROR: odd number of attrs " (vec attrs) " Tree path:" path)]
      (error msg)
      ;(throw (Exception. msg))
      false)))



(defn select-no-keys
  "invert of select-keys. Select all keys except for keys from nokeyseq"
  [map nokeyseq]
  (let [filter-set (set nokeyseq)
        keyseq (filter (comp not filter-set) (keys map))]
    (select-keys map keyseq)))


(defn flatten-node-v1
  "traverse tree and make flat sequence of nodes with paths/parent merged attrs/names etc
   node should have [:key value .. [child] [child] [child]] structure
   :Name - string or function for getting name for node, by default - get-default-smeta-name
   :Flags #{} - set of node options, only :after (position in relation to childs) is supported for now
   TODO: add :no-print, :readonly, etc flags"
  [parent idx node]
  (let [[attrs childs] (split-with (comp not vector?) node)
        path (conj (:Path parent) idx)
        key-path-preliminary (conj (:KeyPath parent) (vec attrs))  ; for error message      
        node-attrs (if (check-even-attrs attrs key-path-preliminary) ; check validity
                     (apply hash-map attrs)        
                     {}) 
        key-attrs (select-no-keys node-attrs [:Name :Flags]) ;all current attrs except :Name and :Flags        
        key (merge (:Key parent) key-attrs)
        key-path (conj (:KeyPath parent) key-attrs)  ; for output row
        node-name (or (:Name node-attrs) get-default-smeta-name)        
        node-flags (:Flags node-attrs)
        is-after (:after node-flags)
        output-row (merge parent node-attrs {:Name node-name :Path path :KeyPath key-path :Key key :CurrAttrs key-attrs})
        childs-indexed (map-indexed (partial flatten-node-v1 output-row) childs)]
    (if is-after 
      (concat (apply concat childs-indexed) [output-row])
      (concat [output-row] (apply concat childs-indexed)))))


(defn de-duplicate-keys
  ":Key attribute of node (natural key) should have unique value
   This function removed duplicate keys and warns about them"
  [rows]
  (let [[key-set-r rows-r] 
          (reduce (fn [[key-set rows] {row-key :Key :as row}]     
            (if (key-set row-key)
              (do
                (warn (str "Duplicate key in row: " row)) 
                [key-set rows])
              [(conj key-set row-key) (conj rows row)])) [#{} []] rows)]
          rows-r))

(defn flatten-tree 
  "Convert root tree nodes to flat sequence of nodes, using flatten-node-v1"
  [tree]
  (doall
  (de-duplicate-keys
    (apply concat (map-indexed (partial flatten-node-v1 {:Path [] :KeyPath []}) tree)))))


(defn get-name
  "Process :Name attribute of node, returns string value of name"
  [{name :Name :as row}]
  (if-not name 
    (do
      (warn "no name for " row) 
      (str row))
    (cond 
      (string? name) name
      (fn? name) (name row)
      (number? name) (str "Name of number-id " name)
      :else 
        (do
          (warn (str "unknown name kind: " row))
          (str row)))))


  

(comment
(defn get-sort-natural
  "Not used. Was used to create natural sorting for rows sequence
  which has no sense"
  [{p :P acc :Acc ho :HO hpo :HPO}]
  (apply str 
    (interpose "_"
      (filter identity
        [(add-zeroes p 7 (or acc ho hpo))
         (add-zeroes acc 7 (or ho hpo))
         (add-zeroes ho 7 hpo)
         (add-zeroes hpo 7 nil)])))))

(defn get-sort-path
  "Create sorting key for documents rows from :Path attribute 
  (i.e. - tree order)"
  [{path :Path}]
  (apply str 
    (interpose "_"
      (map #(add-zeroes % 4 nil) path))))






(defn get-id-dict
  "Get unique ID of node from natural key and generated dictionary"
  [dict node]
  (let [key (:Key node)
        found (dict key)]
    ;(debugs "get-id-dict" node key)    
    (or found 
      (do 
        (warn " id not found: " (str node) )
        -1))))

(defn get-number
  "Get :Number attribute of row"
  [{p :P acc :Acc ho :HO hpo :HPO}]
  
  (if hpo (str ho " " hpo)
    (if ho (str ho)
      (if acc acc
        p))))

;(def smeta-id-dictionary
;  (:dict (load-file "smeta-dictionary.clj")))

(defn get-smeta-rows
  "Convert sequence of tree nodes to sequence of document rows"
  [rows smeta-id-dictionary]
  (map 
    #(merge %1 {:Name (get-name %1)} 
               {:Number (get-number %1)}  
               {:Attributes (:CurrAttrs %1)}
               {:Sort (get-sort-path %1)}
               {:ID (get-id-dict smeta-id-dictionary %1)}) 
    rows))


(defn add-id
  "Fold step. Adds id to dictionary if not found, and increments max id"
  [[dict id] node-key]
  (if (dict node-key) 
    [dict id] 
    [(conj dict [node-key (inc id)]) (inc id)]))


(defn generate-id-dictionary
  "generate new version of id dictionary, with auto-generated IDs 
   and save them to file, which then should be placed in source code
   of current dictionary"
  [original-dict filename nodes]
  (let [max-id (or (:max-id original-dict) 0)
        dict (or (:dict original-dict) {})
        node-keys (map :Key nodes)
        [new-dict new-id] (reduce add-id [dict max-id] node-keys)
        new-file-str (prn-str {:max-id new-id :dict new-dict})
        splitted (str/split new-file-str #",")
        new-file-str-nl (apply str (interpose (str "," tis/system-newline) splitted))]

    (spit (str filename "-new.clj") new-file-str-nl)))