Domain Modelling using Clojure

core.clj

(comment "This is a small experiment inspired by Oskar Wickströms
  excellent work at
  https://haskell-at-work.com/episodes/2018-01-19-domain-modelling-with-haskell-data-structures.html. 
  I wanted to see what would be involved in building the equivalent
  functionality in reasonably ideomatic Clojure. It is also my first
  from scratch use of Clojure spec, which was a very interesting and
  productive experience. It is amazing how little work one has to do
  to be able to generate example datastructures for testing. The
  generated examples helped me find a subtle bug in the tree pretty
  printer, that would have been hard to find without."  "I would love
  any feedback on the code."

  "The purpose of the code is to model a very simple project
  management system and implement simple reporting for same. Hopefully
  the specs makes the code fairly self-explanatory :-)" )

(defrecord Sale [amount])
(defrecord Purchase [amount])

(s/def :project/id pos-int?)
(s/def :project/name (s/and string? seq))
(s/def :project/prj-list (s/and (s/coll-of ::project :gen-max 5) seq))

;; A project is either a simple project or a group of projects.
(s/def ::project
  (s/or :prj (s/keys :req-un [:project/id :project/name])
        :prj-group (s/keys :req-un [:project/name :project/prj-list])))

(s/def ::money decimal?)
(s/def :budget/income ::money)
(s/def :budget/expenditure ::money)
(s/def ::budget (s/keys :req-un [:budget/income :budget/expenditure]))

(s/def ::transaction (s/or :sale #(instance? % Sale)
                           :purchase #(instance? % Purchase)))

(s/def :report/budget-profit ::money)
(s/def :report/net-profit ::money)
(s/def :report/difference ::money)
(s/def ::report (s/keys :req-un [:report/budget-profit :report/net-profit :report/budget-profit]))

;; This is a simple pretty-printer for a project structure. I was somewhat surprised that I couldn't find
;; a generic tree pretty printer, but maybe I missed it.
(defmulti pp-project (fn [p & [indent]] (:id p)))
(defmethod pp-project nil [{:keys [name prj-list]
                            {:keys [budget-profit net-profit difference] :as report} :report}
                            & [indent]]
  (let [indent (or indent "")]
    (str name " - " "Budg.p.: " budget-profit " Net.p.: " net-profit " Diff.: " difference "\n"
     (apply str
            (for [p (butlast prj-list)]
              (str indent "|\n" indent "+-"
                   (pp-project p (str indent "| "))
                   "\n")))
     indent "|\n" indent "`-"
     (pp-project (last prj-list) (str indent "  ")))))

(defmethod pp-project :default [{:keys [id name] {:keys [budget-profit net-profit difference] :as report} :report} & [_]]
  (str " " name " [" id "] " "Budg.p.: " budget-profit " Net.p.: " net-profit " Diff.: " difference))

;; get-budget and get-transactions just produce dummy budgets and transaction lists, ignoring the project id provided.
(defn get-budget [_]
  {:income (bigdec (/ (rand-int 1000000) 100)) :expenditure (bigdec (/ (rand-int 1000000) 100))})

(defn get-transactions [_]
  [(->Sale (bigdec (/ (rand-int 400000) 100))) (->Purchase (bigdec (/ (rand-int 400000) 100)))])

;; Transactable is a bad name, but I couldn't come up with a good alternative.
(defprotocol Transactable
  (transact [t]))

(extend-protocol Transactable
  Sale
  (transact [t]
    (:amount t))
  Purchase
  (transact [t]
    (-' (:amount t))))

(defn calculate-report [{:keys [income expenditure]} transactions]
  (let [budget-profit (- income expenditure)
        net-profit (reduce + (map transact transactions))]
    {:budget-profit budget-profit
     :net-profit net-profit
     :difference (- net-profit budget-profit)}))

;; This is the top-leve reporting function which returns a project structure enriched with :report key/values at all levels of the structure.
(defmulti calculate-project-report :prj-list)

(defmethod calculate-project-report nil [p]
  (assoc p :report 
         (calculate-report (get-budget p) (get-transactions p))))

(defmethod calculate-project-report :default [p]
  (let [reported-prj-list (map calculate-project-report (:prj-list p))]
    (assoc p :report
           (reduce (partial merge-with +) (map :report reported-prj-list))
           :prj-list reported-prj-list)))

;; This is a hard coded example.
(def some-project
  {:name "Sweden"
   :prj-list [{:name "Stockholm"
               :prj-list [{:id 1 :name "Djurgaarden"}
                          {:id 2 :name "Skaergaarden"}]}
              {:id 3
               :name "Gothenborg"}
              {:name "Malmo"
               :prj-list [{:name "Malmo City"
                           :prj-list [{:id 41 :name "Fosie1"}
                                      {:id 42 :name "Fosie2"}
                                      {:name "Fosie3"
                                      :prj-list [{:id 31 :name "Djurgaarden"}
                                                 {:id 32 :name "Skaergaarden"}]}
                                      {:id 5 :name "Rosengaard"}]}
                          {:name "Limhamn"
                           :prj-list [{:id 6 :name "Kalkbrottet"}
                                      {:id 7 :name "Sibbarp"}]}]}
                {:id 4
                 :name "Eskilstuna"}
              ]})

(print (pp-project (calculate-project-report some-project)))

;; This will generate an print example project structures incl. reporting.
(print (pp-project (calculate-project-report (first (gen/sample (s/gen ::project) 1)))))

output.txt

Sweden - Budg.p.: 13989.48 Net.p.: 4682.62 Diff.: -9306.86
|
+-Stockholm - Budg.p.: 7196.79 Net.p.: -650.39 Diff.: -7847.18
| |
| +- Djurgaarden [1] Budg.p.: 5988.90 Net.p.: 46.57 Diff.: -5942.33
| |
| `- Skaergaarden [2] Budg.p.: 1207.89 Net.p.: -696.96 Diff.: -1904.85
|
+- Gothenborg [3] Budg.p.: 5257.84 Net.p.: -799.21 Diff.: -6057.05
|
+-Malmo - Budg.p.: -752.89 Net.p.: 6508.57 Diff.: 7261.46
| |
| +-Malmo City - Budg.p.: -12085.40 Net.p.: 5110.34 Diff.: 17195.74
| | |
| | +- Fosie1 [41] Budg.p.: -6430.92 Net.p.: 1010.62 Diff.: 7441.54
| | |
| | +- Fosie2 [42] Budg.p.: -1081.96 Net.p.: 1353.39 Diff.: 2435.35
| | |
| | +-Fosie3 - Budg.p.: -1506.14 Net.p.: 4885.90 Diff.: 6392.04
| | | |
| | | +- Djurgaarden [31] Budg.p.: 519.58 Net.p.: 2728.45 Diff.: 2208.87
| | | |
| | | `- Skaergaarden [32] Budg.p.: -2025.72 Net.p.: 2157.45 Diff.: 4183.17
| | |
| | `- Rosengaard [5] Budg.p.: -3066.38 Net.p.: -2139.57 Diff.: 926.81
| |
| `-Limhamn - Budg.p.: 11332.51 Net.p.: 1398.23 Diff.: -9934.28
|   |
|   +- Kalkbrottet [6] Budg.p.: 6079.87 Net.p.: 475.04 Diff.: -5604.83
|   |
|   `- Sibbarp [7] Budg.p.: 5252.64 Net.p.: 923.19 Diff.: -4329.45
|
`- Gothenborg [3] Budg.p.: 2287.74 Net.p.: -376.35 Diff.: -2664.09

project.clj

(defproject pms "0.1.0-SNAPSHOT"
  :description "FIXME: write description"
  :url "http://example.com/FIXME"
  :license {:name "Eclipse Public License"
            :url "http://www.eclipse.org/legal/epl-v10.html"}
  :dependencies [[org.clojure/clojure "1.9.0"]
                 [org.clojure/spec.alpha "0.1.143"]]
  :main ^:skip-aot pms.core
  :target-path "target/%s"
  :profiles {:uberjar {:aot :all}
             :dev {:dependencies [[org.clojure/test.check "0.9.0"]]}})