dosync (clj)

(ns uncomplicate.fluokitten.articles.fluokitten-extensions-clojure-core-test
  "These expressions are used as examples in the
    Fluokitten Extensions of Clojure Core
    article at the Fluokitten web site."
  (:use [uncomplicate.fluokitten jvm core test utils])
  (:require [clojure.core.reducers :as r])
  (:use [midje.sweet :exclude [just]]))

 (let [r (ref 5)]
   (dosync
    (fmap! inc r) => r))

 (dosync
  (fmap! + (ref 5) (atom 6) (ref 7)) => (check-eq (ref 18)))

 (dosync (fapply! (ref inc) (ref 2))) => (check-eq (ref 3))

 (dosync (fapply! (ref +) (ref 1) (atom 2) (atom 3)))
 => (check-eq (ref 6))

 (dosync (join! (ref (ref (atom 33)))))
 => (check-eq (ref (atom 33)))

 (dosync (bind! (ref 8) increment))
 => (check-eq (ref 9))

 (dosync (bind! (ref 18) (ref 19) (atom 20) add))
 => (check-eq (ref 57)))

 (dosync
  (fmap inc (ref 5)) => (check-eq (ref 6)))

 (dosync
  (fmap + (ref 5) (atom 6) (ref 7)) => (check-eq (ref 18)))

 (dosync (fapply (ref inc) (ref 2))) => (check-eq (ref 3))

 (dosync (fapply (ref +) (ref 1) (atom 2) (atom 3)))
 => (check-eq (ref 6))

 (dosync (join (ref (ref (atom 33)))))
 => (check-eq (ref (atom 33)))

 (dosync (bind (ref 8) increment))
 => (check-eq (ref 9))

 (dosync (bind (ref 18) (ref 19) (atom 20) add))
 => (check-eq (ref 57))

(ns uncomplicate.fluokitten.core-test
  (:use [uncomplicate.fluokitten algo jvm core test utils])
  (:use [midje.sweet :exclude [just]])
  (:require [clojure.string :as s]
            [clojure.core.reducers :as r]))

(dosync
 (functor-law2 inc (partial * 100) (ref 44)))

(dosync
 (functor-law2 inc (partial * 100) (ref 45) (atom 3) (ref 7)))

(dosync
 (fmap-keeps-type inc (ref 46)))

(dosync
 (fmap-keeps-type + (ref 47) (ref 4) (atom 7)))

(dosync
 (applicative-law1 inc (ref 6)))

(dosync
 (applicative-law1 + (ref 6) (ref 9) (ref -77) (ref -1)))

(dosync
 (applicative-law2-identity (ref 6)))

(dosync
 (applicative-law3-composition (ref inc) (ref (partial * 10)) (ref 6)))

(dosync
 (applicative-law3-composition (ref inc) (ref (partial * 10)) (ref 6) (ref -2)))

(dosync
 (applicative-law4-homomorphism (ref 6) inc 5))

(dosync
 (applicative-law4-homomorphism (ref 6) + 5 -4 5))

(dosync
 (applicative-law5-interchange (ref 6) inc 5))

(dosync
 (applicative-law5-interchange (ref 6) + 5 3 4 5))

(dosync
 (facts "Join function for refs."
        (join (ref 1)) => (check-eq (ref 1))
        (join (ref (ref 2))) => (check-eq (ref 2))))

(dosync
 (monad-law1-left-identity (ref 9) (comp ref inc) 1))

(dosync
 (monad-law1-left-identity (ref 9) (comp ref +) 1 2 3))

(dosync
 (monad-law2-right-identity (ref 9)))

(dosync
 (monad-law3-associativity (comp ref inc) (comp ref (partial * 10)) (ref 9)))

(dosync (magma-op-keeps-type (ref 1) (ref 2)))

(dosync (magma-op-keeps-type (ref 2) (ref 3) (ref 4)))

(dosync (semigroup-op-associativity (ref 5) (ref 6)))

(dosync (semigroup-op-associativity (ref 7) (ref 8) (ref 9)))

(dosync (monoid-identity-law (ref 5)))

(let [r1 (ref 1 :meta {:test true})
      r2 (ref 2 :meta {:test true})]
  (facts  "All refs should preserve metadata."
          (dosync
           (meta (fmap! inc r1))) => {:test true}
          (dosync
           (meta (fmap! + r1 r2)) => {:test true})

          (dosync
           (meta (fapply! (pure r1 inc) r1))) => {:test true}
          (dosync
           (meta (fapply! (pure r1 +) r1 r2))) => {:test true}

          (dosync
           (meta (bind! r1 #(ref (inc %))))) => {:test true}
          (dosync
           (meta (bind! r1 r2 #(ref (+ %1 %2))))) => {:test true}

          (dosync
           (meta (join! (ref (ref 1) :meta {:test true})))) => {:test true}))

   (dosync (bind (ref 1) returning-f)) => (check-eq (ref 2))

(ns io.github.frenchy64.fully-satisfies.non-leaky-macros.clojure.core
  "Implementations of clojure.core macros that don't leak implementation details."
  (:refer-clojure :exclude [locking binding with-bindings sync with-local-vars
                            with-in-str dosync with-precision with-loading-context
                            with-redefs delay vswap! lazy-seq lazy-cat future
                            pvalues])
  (:require [clojure.core :as cc]))

(defmacro non-leaky-dosync
  "Like clojure.core/dosync, except body cannot leak pre/post syntax or use
  recur target."
  [& exprs]
  `(cc/dosync
     (let [res# (do ~@exprs)]
       res#)))

(defmacro dosync
  [& exprs]
  `(non-leaky-dosync ~@exprs))

  ;; First, ensure that it really takes awhile to load.
  (let [start (System/currentTimeMillis)]
    (require 'clojure.core.reducers)
    (is (> (- (System/currentTimeMillis) start) 50)
        "Loading c.c.reducers should take some time."))

  ;; Flush *loaded-libs* so that c.c.reducers is not "loaded" now
  (dosync (ref-set @#'clojure.core/*loaded-libs* (sorted-set)))

(ns 
    ^{:doc "(Performance) Unittests for lambdaroyal memory search abstraction that builds data projections."
      :author "christian.meichsner@live.com"}
    lambdaroyal.memory.abstraction.test-search-projection
  (:require [midje.sweet :refer :all]
            [lambdaroyal.memory.core.tx :refer :all]
            [lambdaroyal.memory.abstraction.search :refer :all]
            [lambdaroyal.memory.core.context :refer :all]
            [lambdaroyal.memory.helper :refer :all]
            [clojure.core.async :refer [>! alts!! timeout chan go]])
  (:import [java.text SimpleDateFormat])
  (:gen-class))

(let [articles '(:apple :banana :avocado)        
      ctx (create-context meta-model)
      tx (create-tx ctx)
      bulk (timed (dosync
                   (doseq [[k v] (zipmap (range) articles)]
                     (insert tx :article k {:name v}))
                   (let [apple (select-first tx :article 0)
                         banana (select-first tx :article 1)
                         avocado (select-first tx :article 2)
                         line-items [{:name :justapple :art1 (first apple) :art2 (first avocado)}
                                     {:name :justbanana :art1 (first banana) :art2 (first banana)}
                                     {:name :appleandbanana :art1 (first banana) :art2 (first apple)}]]
                     (doseq [[k v] (zipmap (range) line-items)]
                       (insert tx :line-item k v))
                     (doseq [[k v] (zipmap (range (count line-items) (* 2 (count line-items))) line-items)]
                       (insert tx :line-item k v)))))
      _ (println "insert took (ms) " (first bulk))
      apple (select-first tx :article 0)
      banana (select-first tx :article 1)
      avocado (select-first tx :article 2)]
  


(facts "check whether projections on non-unique collection associations (collection a referres collection b by two distinct rics"
  (let [articles '(:apple :banana :avocado)        
        ctx (create-context meta-model)
        tx (create-tx ctx)
        bulk (timed (dosync
                     (doseq [[k v] (zipmap (range) articles)]
                       (insert tx :article k {:name v}))
                     (let [apple (select-first tx :article 0)
                           banana (select-first tx :article 1)
                           avocado (select-first tx :article 2)
                           line-items [{:name :justapple :art1 (first apple) :art2 (first avocado)}
                                       {:name :justbanana :art1 (first banana) :art2 (first banana)}
                                       {:name :appleandbanana :art1 (first banana) :art2 (first apple)}]]
                       (doseq [[k v] (zipmap (range) line-items)]
                         (insert tx :line-item k v)))))
        _ (println "insert took (ms) " (first bulk))
        apple (select-first tx :article 0)
        banana (select-first tx :article 1)
        avocado (select-first tx :article 2)]
    (let [ric (ric tx :line-item :article)]
      (fact "ric is present" ric =>  truthy))
    (let [ric (ric tx :line-item :article :art1)]
      (fact "ric is present by specific foreign-key" ric =>  truthy)
      (fact "ric denotes proper foreign-key" (.foreign-key ric) => :art1))
    (let [ric (ric tx :line-item :article :art2)]
      (fact "ric is present by specific foreign-key" ric =>  truthy)
      (fact "ric denotes proper foreign-key" (.foreign-key ric) => :art2))
    (let [ric (ric tx :line-item :article :art3)]
      (fact "ric is present by specific foreign-key" ric =>  falsey))
    (let [proj (by-ric tx :line-item :article [(first apple)] :foreign-key :art1 :verbose true)]
      (fact "specific ric must reveal correct number of items" (count proj) => 1))

(facts "inserting 300 Orders, each with 4-6 partOrders, each partorder with 10-20 lineitems -> 75000 line items"
       (let [types '(:post :express :pick-up :store)
             clients '(:europe :africa :asia)
             targets (range 10)
             deliverers '(:fedex :dhl :post)
             articles '(:banana :apple :peach :plum)
             batches '(:old :new :smelling)
             poid (atom 0)
             oid (atom 0)
             liid (atom 0)
             ctx (create-context meta-model)
             tx (create-tx ctx)
             bulk (timed
                   (dosync
                    (doseq [[k v] (zipmap (range) types)]
                      (insert tx :type k {:name v}))
                    (doseq [[k v] (zipmap (range) clients)]
                      (insert tx :client k {:name v})
                      (doseq [x (range 100)]
                        (insert tx :order (swap! oid inc) {:name (str v x) :client k :deliverer (rand-nth deliverers)})
                        (doseq [y (repeatedly (+ 4 (rand-int 3)) #(swap! poid inc))]
                          (insert tx :part-order y {:order-no (str v x) :order @oid :type (-> types count rand-int) :target (rand-nth targets) :client k}))))))
             _ (println "insert took (ms) " (first bulk))
             _ (println :clients (select tx :client))]
         (let [ric (ric tx :order :client)]
           (fact "order->client" ric =>  truthy)
           (fact "order->client" (.foreign-coll ric) => :client))
         (let [ric (ric tx :part-order :type)]
           (fact "part-order->type" ric =>  truthy)
           (fact "part-order->type" (.foreign-coll ric) => :type))
         (let [proj (by-ric tx :order :client [0])]
           (fact "client->order for one key" (count proj) => 100)
           (fact "client->order for one key" (distinct (map #(-> % last :client) proj)) => [0]))
         
         ;; TESTING WRAPPING UP ALL THE SEARCH LAMBDAS (filter-xxx by the pipe function that does the by-ric
         ;; HELL OF A WORK
         (let [proj ((>> :order (fn [x] true)) tx ((filter-key tx :client 1)))]
           (fact "client->order using the pipe for one key" (count proj) => 100)
           (fact "client->order using the pipe for one key" (distinct (map #(-> % last :client) proj)) => [1]))
         (let [proj ((>> :order (fn [x] true)) tx ((filter-key tx :client > 1)))]
           (fact "client->order using the pipe for key [2]" (count proj) => 100)
           (fact "client->order using the pipe for one key" (distinct (map #(-> % last :client) proj)) => [2]))
         (let [proj ((>>> :part-order) tx ((filter-index tx :order [:name] >= [":europe"])))]
           (fact "order->partorder using the pipe for key [:europe]" (count proj) => (roughly 100 500))
           (fact "client->order using the pipe for one key" (remove #(if (.startsWith % ":europe") %) (map #(-> % last :order-no) proj)) => empty))
         ;;the ugly style variant - but working
         (let [proj ((>>> :part-order) tx
                     ((>>> :order) tx ((filter-key tx :client 2))))]
           (fact "type->order->partorder using the pipe" (count proj) => (roughly 100 500))
           (fact "client->order using the pipe for one key" (remove #(if (= % 2) %) (map #(-> % last :client) proj)) => empty))
         ;;now the more handsome version
         (let [_ (println :proj)
               proj (time (proj tx
                                (filter-key tx :client 2)
                                (>>> :order)
                                (>>> :part-order)))]
           (fact "type->order->partorder using the pipe" (count proj) => (roughly 100 500))
           (fact "client->order using the pipe for one key" (remove #(if (= % 2) %) (map #(-> % last :client) proj)) => empty))


(facts ""
  (let [articles '(:apple :banana :avocado)        
        ctx (create-context meta-model)
        tx (create-tx ctx)
        bulk (timed (dosync
                     (doseq [[k v] (zipmap (range) articles)]
                       (insert tx :article k {:name v}))
                     (let [apple (select-first tx :article 0)
                           banana (select-first tx :article 1)
                           avocado (select-first tx :article 2)
                           line-items [{:name :justapple :art1 (first apple) :art2 (first avocado)}
                                       {:name :justbanana :art1 (first banana) :art2 (first banana)}
                                       {:name :appleandbanana :art1 (first banana) :art2 (first apple)}]]
                       (doseq [[k v] (zipmap (range) line-items)]
                         (insert tx :line-item k v)))))
        _ (println "insert took (ms) " (first bulk))
        apple (select-first tx :article 0)
        banana (select-first tx :article 1)
        avocado (select-first tx :article 2)]
    (let [_ (println :apple apple)
          _ (println :banana banana)
          _ (println :avocado avocado)
          _ (doseq [x (select tx :line-item)]
              (println :x x))
          apple-line-items (take 2 (filter #(= (first apple) (-> % last :art1)) (select tx :line-item)))
          _ (println :apple-line-items apple-line-items)
          banana-line-items (take 3 (filter #(= (first banana) (-> % last :art1)) (select tx :line-item)))
          _ (println :banana-line-items banana-line-items)
          proj' (by-referencees tx :line-item :article (concat banana-line-items apple-line-items) :verbose true)
          proj'' (proj tx (filter-xs :line-item (concat banana-line-items apple-line-items ))
                       (<<< :article :verbose true))]
      (fact "by-reference must reveal a set of articles without redundancies"
        proj' => [banana apple])
      (fact "<<< must reveal a set of articles without redundancies"
        proj'' => [banana apple]))))