diff --git a/otus-06/project.clj b/otus-06/project.clj index aa12fd1..cee1664 100644 --- a/otus-06/project.clj +++ b/otus-06/project.clj @@ -6,4 +6,4 @@ :dependencies [[org.clojure/clojure "1.11.1"] [aero "1.1.6"]] - :repl-options {:init-ns otus-06.core}) + :repl-options {:init-ns otus-06.homework}) diff --git a/otus-06/src/otus_06/homework.clj b/otus-06/src/otus_06/homework.clj index d5d5228..914d204 100644 --- a/otus-06/src/otus_06/homework.clj +++ b/otus-06/src/otus_06/homework.clj @@ -1,4 +1,7 @@ -(ns otus-06.homework) +(ns otus-06.homework + (:require [clojure.string :as str] + [clojure.edn :as edn] + [clojure.java.io :as io])) ;; Загрузить данные из трех файлов на диске. ;; Эти данные сформируют вашу базу данных о продажах. @@ -92,5 +95,286 @@ ;; *** Дополнительно можно реализовать возможность добавлять новые записи в исходные файлы ;; Например добавление нового пользователя, добавление новых товаров и новых данных о продажах - ;; Файлы находятся в папке otus-06/resources/homework + + +(defn get-user-answer + "Принимает запрос к пользователю и функцию pf, которой проверяется + ответ пользователя. Если возвращается nil, повторяет запрос" + [promt pf] + (loop [] + (println promt) + (if-let [ans (pf (read-line))] + ans + (recur)))) + +;; **************************** +;; Функции для работы с БД + +(def db { + :customer { + :data [] + :field [:id :name :addres :phone] + :field-type [int str str str] + :format ["%3d" "%20s" "%-20s" "%10s"] + :file "homework/cust.txt" + :save-promt [["Name: "] ["Addres: "] ["Phone: "]]} + :product {:data [] + :field [:id :description :cost] + :field-type [int str double] + :format ["%3d" "%20s" "%5.2f"] + :file "homework/prod.txt" + :save-promt [["Description: "] ["Cost:"]]} + :sales { + :data [] + :field [:id :customer-id :product-id :count] + :field-type [int int int int] + :format ["%3d" + [:customer :id :name "%20s"] + [:product :id :description "%10s"] + "%3d"] + :save-promt [["Customer: " [:customer :name]] + ["Product: " [:product :description]] + ["Count: "]] + :file "homework/sales.txt"}}) + +(defn get-settings [settings] + (fn [db table] + (get-in db [table settings]))) +(def get-filename (get-settings :file)) +(def get-fieldname (get-settings :field)) +(def get-data (get-settings :data)) +(def get-format (get-settings :format)) +(def get-save-promt (get-settings :save-promt)) + + +(defn read-string* [s] + ;; Я не нашел как заставить read-string + ;; корректно прочитать "123-456" "123 jonh" и т.п. + ;; Решил обойти таким образом. + ;; Буду благодарен за подсказку + (if (re-matches #"\d+\.?\d*" s) + (edn/read-string s) + s)) + +(defn create-row + "Делает из строки или суквенции мапу для вставки в БД" + [line fields] + (->> (if (string? line) + (->> line + (#(str/split % #"\|")) + (map read-string*)) + line) + (zipmap fields))) + +(defn add-row + "Добавляет строку в БД" + [table db line] + (update-in db + [table :data] + conj + (create-row line (get-fieldname db table)))) + + +(defn load-table + "Читает данные из файла и загружает их в таблицу" + [db table] + (with-open [f (-> (get-filename db table) + (io/resource) + (io/reader))] + (->> f + line-seq + (reduce (partial add-row table) db)))) + +(defn load-db + "Загружает всю БД" + [db] + (reduce load-table db (keys db))) + +(defn find-row + "Ищет строки в которых field = x" + [db table field x] + (filterv #( = x (field %))(get-data db table))) + +(defn find-first-row + "Ищет первую строку, попадающую под условия"[db table field x] + (first (find-row db table field x))) + +(defn format-field + "Форматирует поле таблицы в соответсвии с заданным форматом. + Заодно подгружает название из других таблиц, если есть справочник" + [db] + (fn [fmt s] + (if (vector? fmt) + (let [[tbl fld name-field fs] fmt + name (name-field(find-first-row db tbl fld s))] + (format fs name)) + (format fmt s)))) + +(defn show-table + "Отображает всю таблицу. + Основная функция для входа из меню" + [db table] + (let [format-str (get-format db table)] + (doseq [row (get-data db table)] + (->> (map row (get-fieldname db table)) + (map (format-field db) format-str) + (str/join " | ") + println)) + (println "Enter to continue..") + (read-line) + db)) + +(defn nothing + "Ничего не делает" + [& args] + (first args)) + +;;************************************* +;; Функции для работы с отчетом + +(def reports {:cost-by-user + {:data [* [[:product-id [:product :cost]] [:count]]] + :groupby [:customer-id [:customer :id :name]] + :format ["\nEnter user name: " "%s: %5.2f\n"]} + :prod-count + {:data [nothing [[:count]]] + :groupby [:product-id [:product :id :description]] + :format ["\nEnter product name: " "%s: %3.0f\n"]}}) + +(defn get-rep-exp [rep] + (get-in reports [rep :data])) +(defn get-rep-groupby [rep] + (get-in reports [rep :groupby])) +(defn get-rep-format [rep] + (get-in reports [rep :format])) + + +(defn get-val + "Получает данные в соответсвии с exp, + опирается при этом на row" + [db exp row] + (if (= 1 (count exp)) + ((first exp) row) + (let [[f-id [tbl fld]] exp] + (fld (find-first-row db tbl :id (f-id row)))))) + +(defn calc-report + "Вычисляет значение, необходимое для отчета" + [db rep name] + (let [[f args] (get-rep-exp rep) + [f-group [t-search f-id f-search]] (get-rep-groupby rep)] + (if-let [id (f-id (find-first-row db t-search f-search name))] + (let [rows (find-row db :sales f-group id) + arg-func (map #(partial get-val db %) args) + arg-rows (map (apply juxt arg-func) rows)] + (* (apply + (map #(apply f %) arg-rows)) 1.0)) + 0.0))) + +(defn show-report + "Выводит отчет. Основная для входа из менб" + [db rep] + (let [[promt, fmt] (get-rep-format rep)] + (println promt) + (let [name (read-line)] + (println (format fmt name (calc-report db rep name))))) + db) +;;************************************* +;; Функции для добавления записей + +(defn create-string + "Принимает вектор значений и возвращает строку, как в файле" + [fields row] + (->> (map row fields) + (map str) + (str/join "|"))) + +(defn save-table + "Сохраняет таблицу в файл" + [db table] + (spit + (io/resource (get-filename db table)) + (let [fields (get-fieldname db table)] + (->> (get-data db table) + (map (partial create-string fields)) + (str/join "\n")))) + db) + +(defn promt-cell + "Запрашивает у пользователя ввод очередного поля. + Проверяет его на допустимость и возвращает нужное значение" + [acc exp] + (let [[db _] acc + [promt [table field]] exp] + (if (nil? table) + (get-user-answer promt nothing) + (get-user-answer promt + #(:id (find-first-row db table field %)))))) + +(defn add-cell + "Добавляет новую ячейку в строку" + [acc exp] + (update-in acc [1] conj (promt-cell acc exp))) + + +(defn promt-row + "Запрашивает все данные для новой записи" + [db table] + (let [max-id (apply max (map :id (get-data db table))) + row (reduce add-cell [db [(str (inc max-id))]] (get-save-promt db table))] + (-> (row 1) + (#(str/join "|" %))))) + + +(defn new-row + "Реализует пункт меню с добавлением записей" + [db table] + (->> (promt-row db table) + (add-row table db) + (#(save-table % table)))) + + +;;************************************* +;; Функции для работы с меню + +(defn exit [_] + (System/exit 0)) + +(def menu (into + (sorted-map) + {"1" {:name-menu "Display Customer Table" + :func #(show-table % :customer)} + "2" {:name-menu "Display Product Table" + :func #(show-table % :product)} + "3" {:name-menu "Display Sales Table" + :func #(show-table % :sales)} + "4" {:name-menu "Total Sales for Customer" + :func #(show-report % :cost-by-user)} + "5" {:name-menu "Total Count for Product" + :func #(show-report % :prod-count)} + "6" {:name-menu "New Customer" + :func #(new-row % :customer)} + "7" {:name-menu "New Product" + :func #(new-row % :product)} + "8" {:name-menu "New Sale" + :func #(new-row % :sales)} + "9" {:name-menu "Exit" + :func exit}})) + +(defn check-menu [answer] + (get-in menu [answer :func])) + +(defn show-menu + "Выводит меню и просит сделать выбор" + [] + (println "*** MAIN MENU ***") + (doseq [[k v] menu] + (println k " - " (:name-menu v))) + (get-user-answer "Enter your choice: " check-menu)) + +(defn -main + "Точка входа. Крутит меню и запускает нужные функции" + [] + (reduce #(%2 %1) (load-db db) (repeatedly show-menu))) + +;; (-main)