Example models (#1137)

* examples - first commit.
extra containers info not needed in components, this data is already available via the fns containing-parents/contained-children.

* minor fixes in text

* preprocess patterns in conditional matches

* docstring support for dataflows

* customer loyalty example

* add resolver example

example/loyalty/loyalty/core.fractl

@@ -0,0 +1,46 @@
+(component :Loyalty.Core)
+
+(entity :Customer
+ {:Email {:type :Email :guid true}
+  :Name :String
+  :Joined :Now})
+
+(entity :Point
+ {:Value :Int
+  :Created :Now
+  :meta {:doc "Loyalty point earned by a customer for each purchase."}})
+
+(relationship :Points
+ {:meta {:between [:Customer :Point]}})
+
+(entity :Purchase
+ {:CustomerEmail :Email
+  :InvoiceNo {:type :String :guid true}
+  :Date :Now
+  :Amount :Decimal})
+
+(defn compute-points
+  "Compute the loyalty point based on the purchase amount."
+  [amt]
+  (cond
+    (>= amt 5000.0) 10
+    (>= amt 2000.0) 5
+    :else 2))
+
+(dataflow [:after :create :Purchase]
+ "When a new purchase happens, use its amount to compute 
+a loyalty point for the customer."
+ [:match
+  [:> :Instance.Amount 1000.0]
+  {:Point {:Value '(compute-points :Instance.Amount)}
+   :-> [[{:Points {}} {:Customer {:Email? :Instance.CustomerEmail}}]]}
+  :Instance])
+
+(defn total-points [ps]
+  (reduce + 0 (map :Value ps)))
+
+(dataflow :FetchPoints
+ "Return the total loyalty-points for a customer."
+ {:Point? {} :-> [[{:Points {:Customer? :FetchPoints.CustomerEmail}}]]
+  :as :Result}
+ [:eval '(total-points :Result)])

example/loyalty/model.fractl

@@ -0,0 +1,5 @@
+{:name :loyalty
+ :doc "Customer Loyalty Program Management"
+ :version "0.0.1"
+ :fractl-version "current"
+ :components [:Loyalty.Core]}

example/school/model.fractl

@@ -0,0 +1,4 @@
+{:name :school
+ :version "0.0.1"
+ :fractl-version "current"
+ :components [:School.Core]}

example/school/school/core.fractl

@@ -0,0 +1,96 @@
+(component :School.Core)
+
+(entity
+ :School
+ {:Name {:type :String :guid true}
+  :RegistrationNumber {:type :String :unique true}
+  :Address :String})
+
+(attribute
+ :Gender
+ {:oneof ["M" "F"]})
+
+(entity
+ :Student
+ {:EnrollmentNumber {:type :Int :id true}
+  :Id :Identity
+  :Name :String
+  :Age :Int
+  :Gender :Gender
+  :EnrollmentDate :Date})
+
+(entity
+ :ParentInfo
+ {:Address :String
+  :ParentName :String
+  :ParentEmail :Email
+  :ParentPhoneNumber :String})
+
+(relationship
+ :ParentInfoForStudent
+ {:meta {:between [:Student :ParentInfo]}})
+
+(relationship
+ :StudentOf
+ {:meta {:contains [:School :Student]}})
+
+(entity
+ :Teacher
+ {:StaffNumber {:type :Int :id true}
+  :Id :Identity
+  :Name :String
+  :Age :Int
+  :Gender :Gender
+  :Designation :String
+  :Qualification :String
+  :JoiningDate :Date})
+
+(entity
+ :ContactInfo
+ {:Address :String
+  :Email :Email
+  :PhoneNumber :String})
+
+(relationship
+ :TeacherContactInfo
+ {:meta {:between [:Teacher :ContactInfo]}})
+
+(relationship
+ :StaffOf
+ {:meta {:contains [:School :Teacher]}})
+
+(entity
+ :Class
+ {:Id :Identity
+  :Name :String
+  :Grade :String
+  :meta {:unique [:Name :Grade]}})
+
+(entity
+ :Subject
+ {:Name {:type :String :guid true}
+  :Texts {:listof :String}})
+
+(relationship
+ :ClassTeacher
+ {:meta {:between [:Teacher :Class]}})
+
+(relationship
+ :TeachingAssignment
+ {:meta {:between [:Teacher :Subject]}
+  :AssignedOn :Now
+  :Class {:ref :Class.Id}})
+
+(relationship
+ :Enrollment
+ {:meta {:between [:Student :Class]}
+  :EnrolledOn :Now})
+
+(entity
+ :Attendance
+ {:Date :Now
+  :Present :Boolean})
+
+(relationship
+ :ClassAttendance
+ {:meta {:between [:Student :Attendance]}})

example/todo/model.fractl

@@ -0,0 +1,5 @@
+{:name :todo
+ :doc "TODO app with custom data-store."
+ :version "0.0.1"
+ :fractl-version "current"
+ :components [:Todo.Core]}

example/todo/todo/core.fractl

@@ -0,0 +1,48 @@
+(component :Todo.Core)
+
+;; This example shows how to persist instances of an
+;; entity (:TodoEntry) in a custom format.
+;; This is achieved via a custom "resolver" that writes
+;; and reads :TodoEntry instances to a file in a user-specified
+;; format.
+
+(entity :TodoEntry
+ {:Content :String
+  :DateCreated :Now})
+
+(def buffer (atom nil))
+(def todo-file ".todo")
+
+(defn refresh-buffer! []
+  (try
+    (reset! buffer (read-string (slurp todo-file)))
+    (catch Exception _ nil)))
+
+(defn flush-buffer! []
+  (spit todo-file @buffer))
+
+(defn upsert [inst]
+  (when-not @buffer
+    (refresh-buffer!))
+  (swap! buffer conj [(:DateCreated inst) (:Content inst)])
+  (flush-buffer!)
+  inst)
+
+(defn as-todo-entry [[date-created content]]
+  {:Content content
+   :DateCreated date-created})
+
+(defn lookup-entries [[_ query]]
+  (when-not @buffer
+    (refresh-buffer!))
+  (let [[_ _ value] (:where query)
+        entries (filter #(clojure.string/index-of (second %) value) @buffer)]
+    (mapv as-todo-entry entries)))
+
+(def todo-resolver
+  (fractl.resolver.core/make-resolver
+   :todo.resolver ; a unique name for the resolver.
+   {:create upsert
+    :query lookup-entries}))
+
+(fractl.resolver.registry/override-resolver :Todo.Core/TodoEntry todo-resolver)

src/fractl/compiler.cljc

@@ -618,12 +618,12 @@
   (loop [clauses pat, code []]
     (if-let [c (first clauses)]
       (if-not (seq (rest clauses))
-        {:clauses code :else (compile-pattern ctx c)}
+        {:clauses code :else (compile-maybe-pattern-list ctx (normalize-and-preproc c))}
         (recur (nthrest clauses 2)
                (conj
                 code
                 [(rule/compile-rule-pattern c)
-                 (compile-pattern ctx (second clauses))])))
+                 (compile-maybe-pattern-list ctx (normalize-and-preproc (second clauses)))])))
       {:clauses code})))
 
 (defn- compile-match-cond [ctx pat]

src/fractl/component.cljc

@@ -127,7 +127,6 @@
 (def ^:private type-key :-*-type-*-)
 (def ^:private dirty-key :-*-dirty-*-)
 (def type-tag-key :type-*-tag-*-)
-(def ^:private containers-key :-*-containers-*-)
 
 (def instance->map identity)
 (def instance-type-tag type-tag-key)
@@ -163,23 +162,8 @@
 
 (def meta-of mt/meta-of-key)
 
-(defn- intern-contains [components rec-name contains]
-  (loop [containers (containers-key components)
-         contains contains]
-    (if-let [f (first contains)]
-      (let [p (li/split-path f)]
-        (if-let [c (get containers p)]
-          (do (log/warn (str c " already contains " f ", only one :contains relatonship is allowed"))
-              (recur containers (rest contains)))
-          (recur (assoc containers p rec-name) (rest contains))))
-      (assoc components containers-key containers))))
-
 (defn- intern-meta [typtag components rec-name meta]
-  (let [cs (if-let [cnts (and (not (:relationship meta))
-                              (mt/contains meta))]
-             (intern-contains components rec-name cnts)
-             components)]
-    (assoc-in cs (conj-meta-key rec-name) meta)))
+  (assoc-in components (conj-meta-key rec-name) meta))
 
 (defn- component-intern
   "Add or replace a component entry.
@@ -205,10 +189,6 @@
   ([typname typdef typtag]
    (component-intern typname typdef typtag nil)))
 
-(defn fetch-container [rec-name]
-  (let [containers (get @components containers-key)]
-    (get containers (li/split-path rec-name))))
-
 (defn- component-find
   ([path]
    (get-in @components path))

src/fractl/gpt/resolver_seed.cljc

@@ -2,7 +2,7 @@
 
 (def conversation
   [{:role "system" :content "You are the fractl assistant."},
-   {:role "system" :content "All http requests will be handles using the http-kit library, json handling will be done with the cheshire.core library, aws handling will be done with the amazonica library, and system util processes will be done using fractl.util (i.e. getting system environment variables with fractl.util/getenv)"},
+   {:role "system" :content "All http requests will be handled using the http-kit library, json handling will be done with the cheshire.core library, aws handling will be done with the amazonica library, and system util processes will be done using fractl.util (i.e. getting system environment variables with fractl.util/getenv)"},
    {:role "system" :content "Leave no implementation to the user, add all implementation yourself"},
    {:role "system" :content "All of the resolver functions are to be defined outside of the resolver definition, and will be accessed using the definition below:
 

src/fractl/lang.cljc

@@ -515,14 +515,18 @@
       (intern-inferred-event n))
     (u/throw-ex (str "not an event - " x))))
 
-(defn ensure-dataflow-pattern! [x]
+(defn- ensure-dataflow-pattern! [x]
   (cond
     (keyword? x) (li/validate-name-relaxed x)
     (or (map? x) (li/special-form? x) (symbol? x)) x
     :else (u/throw-ex (str "Invalid dataflow pattern. Possible syntax error - " x))))
 
-(defn ensure-dataflow-patterns! [xs]
-  (doseq [x xs] (ensure-dataflow-pattern! x)))
+(defn- prepare-dataflow-patterns [xs]
+  (let [xs (if (and (seqable? xs) (string? (first xs))) ; ignore docstring
+             (rest xs)
+             xs)]
+    (doseq [x xs] (ensure-dataflow-pattern! x))
+    xs))
 
 (declare normalize-event-pattern)
 
@@ -661,8 +665,8 @@
                    (event-self-ref-pattern (preproc-match-pat match-pat)))
 
             :else
-            (let [match-pat (or (preproc-match-pat match-pat) match-pat)]
-              (ensure-dataflow-patterns! patterns)
+            (let [match-pat (or (preproc-match-pat match-pat) match-pat)
+                  patterns (prepare-dataflow-patterns patterns)]
               (if (vector? match-pat)
                 (apply
                  dataflow

src/fractl/policy.cljc

@@ -10,7 +10,7 @@
     (li/make-path p)
     p))
 
-(declare lookup-container-policies)
+(declare lookup-parent-policies)
 
 (defn lookup-policies [intercept resource]
   (or
@@ -23,11 +23,11 @@
               {:Intercept (u/keyword-as-string intercept)
                :Resource (u/keyword-as-string (normalize-path resource))}})]
         (u/ok-result result true)))
-   (lookup-container-policies intercept resource)))
+   (lookup-parent-policies intercept resource)))
 
-(defn- lookup-container-policies [intercept resource]
-  (when-let [c (cn/fetch-container resource)]
-    (lookup-policies intercept c)))
+(defn- lookup-parent-policies [intercept resource]
+  (when-let [[_ _ p] (cn/containing-parents resource)]
+    (lookup-policies intercept p)))
 
 (defn create-policy [intercept resource spec]
   (let [result

test/fractl/test/fixes03.cljc

@@ -668,3 +668,46 @@
       (is (cn/same-instance?
            g (tu/first-result
               {:Mqs/Lookup_G {li/path-attr (li/path-attr g)}}))))))
+
+(deftest preproc-cond-match
+  (defcomponent :Pcm
+    (entity
+     :Pcm/A
+     {:Id :Identity
+      :X :Int})
+    (entity
+     :Pcm/B
+     {:Id {:type :Int :guid true}
+      :Y :Int})
+    (relationship
+     :Pcm/R
+     {:meta {:between [:Pcm/A :Pcm/B]}})
+    (dataflow
+     :Pcm/MakeB
+     [:match
+      [:> :Pcm/MakeB.Id 10]
+      {:Pcm/B {:Y :Pcm/MakeB.Y :Id :Pcm/MakeB.Id}
+       :-> [[{:Pcm/R {}} {:Pcm/A {:Id? :Pcm/MakeB.A}}]]}
+      {:Pcm/B {:Y :Pcm/MakeB.Y :Id :Pcm/MakeB.Id}}]))
+  (let [cra (fn [x]
+              (tu/first-result
+               {:Pcm/Create_A
+                {:Instance
+                 {:Pcm/A {:X x}}}}))
+        [a1 a2] (mapv cra [1 2])
+        mkb (fn [a id y]
+              (let [b (tu/result
+                       {:Pcm/MakeB
+                        {:A a :Id id :Y y}})]
+                (if (map? b) b (first b))))
+        b1 (mkb (:Id a1) 10 100)
+        b2 (mkb (:Id a1) 11 200)
+        b3 (mkb (:Id a2) 12 300)
+        a? (partial cn/instance-of? :Pcm/A)
+        b? (partial cn/instance-of? :Pcm/B)]
+    (is (every? a? [a1 a2]))
+    (is (every? b? [b1 b2 b3]))
+    (let [rs (tu/result {:Pcm/LookupAll_R {}})]
+      (is (= 2 (count rs)))
+      (is (every? (partial cn/instance-of? :Pcm/R) rs))
+      (is (= [11 12] (vec (sort (mapv :B rs))))))))