Skip to content

Instantly share code, notes, and snippets.

@maacl
Last active Aug 2, 2021
Embed
What would you like to do?
Domain Modelling using Clojure
(ns pms.core
(:require [clojure.spec.alpha :as s]
[clojure.spec.gen.alpha :as gen]
[clojure.spec.test.alpha :as stest]))
(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 (transduce (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
(transduce (map :report) (partial merge-with +) 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)))))
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
(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"]]}})
@owickstrom
Copy link

owickstrom commented Nov 17, 2018

Looking back at this, I love how you added more projects with good names. 👍

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment