freefrog

0.0.1-SNAPSHOT


freefrog

dependencies

clj-http
2.0.0
clj-json
0.5.3
clj-time
0.10.0
selmer
0.8.7
instaparse
1.4.1
org.clojure/clojure
1.7.0
org.clojure/tools.cli
0.3.2
org.clojure/tools.logging
0.3.1
speclj
3.3.1



(this space intentionally left almost blank)
 
(ns freefrog.cli
  (:require [clojure.string :as str]
            [clojure.tools.cli :as cli]
            [clojure.walk :as walk]
            [freefrog.governance :as g]
            [freefrog.lang :as l]
            [freefrog.render :as render])
  (:gen-class))
(def cli-options
  [["-d" "--dir DIR" "Directory of governance documents"
    :id :dir]
   ["-h" "--help"]])
(defn- select-circle [anchor-circle circle-path]
  (update-in (if (seq circle-path)
               (get-in anchor-circle (g/path-to-role circle-path))
               anchor-circle)
             [:roles]
             #(walk/postwalk (fn [thing]
                               (if (satisfies? g/RoleContainer thing)
                                 (dissoc thing :roles)
                                 thing)) %)))
(def path (atom []))
(def command (atom ))
(defn interpret-command! [anchor-circle]
  (let [c @command]
    (cond
      (.startsWith c "r")
      (let [idx (Integer/valueOf (subs c 1))
            current-path @path
            circle-to-introspect
            (get-in anchor-circle (g/path-to-role current-path))
            rendered-circle
            (render/reduce-to-names-with-indices circle-to-introspect :roles)
            role (-> rendered-circle
                     :roles
                     (nth idx)
                     :name)]
        (swap! path conj role)
        nil)
      (= ".." c) (do (swap! path pop) nil)
      (= "/" c) (do (reset! path []) nil)
      (= "?" c) (str
                  "====\n"
                  "help\n"
                  "====\n"
                  "..\tUp one\n"
                  "/\tBack to Anchor\n"
                  "r##\tDescend to role indicated by index\n\n"))))
(defn -main [& args]
  (let [{:keys [options arguments errors summary]}
        (cli/parse-opts args cli-options)
        {:keys [dir]} options]
    (while true
      (try
        (let [anchor-circle (l/execute-directory dir)
              extra-text (interpret-command! anchor-circle)
              selected-circle (select-circle anchor-circle @path)]
          (println (render/markdown-role selected-circle))
          (if extra-text (println extra-text)))
        (catch Throwable t
          (.printStackTrace t))
        (finally (print (str (str/join "/" @path) ": "))
                 (flush)
                 (let [entry (read-line)]
                   (reset! command entry)))))))
 

These are the core rules defined in the Holacracy Constitution

(ns freefrog.core-roles
  (:require [freefrog.governance :as g]))
(def lead-link
  (g/map->Role
    {:rname g/lead-link-name
     :purpose
            (str "The Lead Link Role shall be deemed to hold the purpose of "
                 "the overall Circle.")
     :domains
            [(get g/core-role-domains g/lead-link-name)]
     :accountabilities
            [(str "Differentiating and organizing the Circle's overall work "
                  "into segmented Roles and other requisite Governance")
             (str "Assigning Partners to the Circle's Roles, monitoring fit "
                  "between Partners and their Roles and offering feedback to "
                  "enhance fit, and removing Partners from Roles when useful")
             (str "Allocating the Circle's available resources across its "
                  "various Projects and/or Roles")
             "Assessing and defining priorities and Strategies for the Circle"
             (str "Defining and assigning metrics within the Circle that "
                  "provide visibility into such Circle's expression of its "
                  "Purpose and enactment of its Accountabilities")]}))
(def rep-link
  (g/map->Role
    {:rname g/rep-link-name
     :purpose
            (str "Within the Super-Circle, the Rep Link Role shall be deemed "
                 "to hold the purpose of the overall Circle so represented; "
                 "within such Circle, the Rep Link Role's Purpose shall be: "
                 "Tensions relevant to process in the Super-Circle channeled "
                 "out and resolved.")
     :accountabilities
            [(str "Removing constraints within the Super-Circle that limit the "
                  "Circle's capacity to express its Purpose or "
                  "Accountabilities")
             (str "Seeking to understand Tensions conveyed by and of the "
                  "Circle's Circle Members, and discerning those appropriate "
                  "to channel into the Super-Circle for processing")
             (str "Providing visibility to the Super-Circle into the health "
                  "and sustainability of operations within the Circle, "
                  "including reporting data within the Super-Circle for any "
                  "metrics or checklist items assigned to the overall "
                  "Circle")]}))
(def facilitator
  (g/map->Role
    {:rname g/facilitator-name
     :purpose
            (str "Circle governance and operational practices aligned with "
                 "the core rules and processes of this Constitution.")
     :accountabilities
            [(str "Facilitating the Circle's Governance Meetings and Tactical "
                  "Meetings in alignment with the rules of this Constitution, "
                  "and enforcing such rules during such meetings as-needed")
             (str "Auditing the meetings and records of the Circle's "
                  "Sub-Circles to assess alignment with this Constitution, "
                  "including at a minimum whenever prompted to do so by the "
                  "Rep Link from a Sub-Circle, and initiating the restorative "
                  "process defined in this Constitution if a Process Breakdown "
                  "is discovered within a Sub-Circle")]}))
(def secretary
  (g/map->Role
    {:rname g/secretary-name
     :purpose
            (str "Stabilize the Circle's Governance over time as a steward of "
                 "the Circle's formal records and record-keeping process")
     :domains
            [(get g/core-role-domains g/secretary-name)]
     :accountabilities
            [(str "Maintaining all records of a Circle required by this "
                  "Constitution, including capturing the outputs of the "
                  "Circle's governance process and Tactical Meetings, "
                  "maintaining a compiled view of all Governance currently in "
                  "effect for the Circle, and maintaining a list of all "
                  "operational elements currently being monitored in Tactical "
                  "Meetings")
             (str "Scheduling all regular and special meetings of the Circle "
                  "explicitly required by this Constitution or by a Policy "
                  "established by the Circle, in alignment with the terms of "
                  "this Constitution and any relevant Policies of the Circle, "
                  "and notifying all Core Circle Members of times and "
                  "locations for meetings so scheduled")
             (str "Interpreting the acting Governance of the Circle upon "
                  "request of a Circle Member as provided for in this "
                  "Constitution, including ruling on matters of due process, "
                  "procedure, and authority related to or granted under such "
                  "Governance or this Constitution itself")]}))
 

Governance Encoding

Defines how governance can be manipulated, and is intended to comply to the Holacracy Constitution v4.0

Designed to provide all manipulation functions for Holacracy governance structures. It is not recommended that the structures generated/manipulated by this namespace be manually edited outside of this namespace for any purpose.

This would cause difficulties tracking down the source of a structure should one need to do so. It also adds the benefit of having all logic in one place so one can more easily reason about it.

(ns freefrog.governance
  (:require [clojure.set :as s]))
(def lead-link-name "Lead Link")
(def rep-link-name "Rep Link")
(def secretary-name "Secretary")
(def facilitator-name "Facilitator")
(def elected-role-mapping {facilitator-name :facilitator
                           secretary-name   :secretary
                           rep-link-name    :rep-link})
(defn is-lead-link? [role-name]
  (= lead-link-name role-name))
(def elected-roles
  #{facilitator-name secretary-name})
(def core-roles
  (into elected-roles #{lead-link-name rep-link-name}))
(def role-assignments-domain "Role assignments within the Circle")
(def governance-records-domain
  (str "All records required of a Circle under this Constitution, and any "
       "record-keeping processes and systems required to create and "
       "maintain such records for the Circle"))
(def core-role-domains {lead-link-name role-assignments-domain
                        secretary-name governance-records-domain})

General purpose utility functions

(defn- simple-entity-path
  [role-name entities]
  (concat [:roles role-name] entities))
(defn entity-path
  [role-name & entities]
  (simple-entity-path role-name entities))
(defn get-role [circle role-name]
  (get-in circle (entity-path role-name)))
(defn- get-entity-raw
  ([circle entities]
   (get-in circle entities))
  ([circle role-name entities]
   (get-entity-raw circle (simple-entity-path role-name entities))))

Same as get-entity-raw but nicer.

(defn- get-entity
  [circle role-name & entities]
  (get-entity-raw circle role-name entities))
(defn- role-missing? [circle role-name]
  (empty? (get-role circle role-name)))

Validators

(defn- validate [valid? err-msg]
  (when-not valid? (throw (IllegalArgumentException. err-msg))))
(defn- validate-not [invalid? err-msg]
  (validate (not invalid?) err-msg))
(defn- validate-role-exists [circle role-name]
  (validate-not (role-missing? circle role-name)
                (str "Role not found: " role-name)))
(defn- validate-name [thing-type thing-name]
  (validate-not (empty? thing-name)
                (format "%s name may not be empty" thing-type)))
(defn- validate-role-updates [circle role-name]
  "Checks that the role name is not empty and that it exists in the circle."
  (validate-name "Role" role-name)
  (validate-role-exists circle role-name))

Types

(defprotocol GovernanceRecord
  (is-circle? [record]))
(defprotocol RoleContainer
  (add-role [container role])
  (remove-role [container role-name])
  (rename-role [container role-name new-name]))
(defrecord Role [rname purpose domains accountabilities policies assignees]
  GovernanceRecord
  (is-circle? [_] false))

todo This re-definition of fields in Circle is ridiculous.

(defrecord Circle [rname purpose domains accountabilities policies roles
                   facilitator secretary rep-link]
  GovernanceRecord
  (is-circle? [_] true)
  RoleContainer
  (add-role [circle role]
    (let [new-role-name (:rname role)]
      (validate-name "Role" new-role-name)
      (validate-not (get-in circle [:roles new-role-name])
                    (str "Role already exists: " new-role-name))
      (update-in circle [:roles] assoc new-role-name role)))
  (remove-role [circle role-name]
    (validate-role-updates circle role-name)
    (let [result (update-in circle [:roles] dissoc role-name)]
      (if (empty? (:roles result))
        (assoc result :roles nil)
        result)))
  (rename-role [circle role-name new-name]
    (validate-role-updates circle role-name)
    (-> circle
        (update-in [:roles] s/rename-keys {role-name new-name})
        (update-in [:roles new-name] assoc :rname new-name))))

Create a new circle with no parent.

(defn create-circle
  [circle-name]
  (validate-not (empty? circle-name) "Circle name may not be empty")
  (map->Circle {:rname circle-name}))

Returns true if the given circle really is a circle. If you give it a role, it will tell you if the given role inside the given circle is a circle.

(defn is-subrole-circle?
  [circle role-name]
  (is-circle? (get-role circle role-name)))
(def ^:private sets-of-things {:domains          "Domain"
                               :accountabilities "Accountability"
                               :policies         "Policy"
                               :assignees        "Person"})

Abstract function to validate collections of things in a circle. The variant that takes a role-name checks that the role name is non-empty and present. Also calls the custom validation function.

If the check-fn returns true, throws an error with the given err-msg-fmt. err-msg-fmt be in the form of ^.%s.%s.%s.$ where the first %s is to be replaced with a singular English representation of the given component (see sets-of-things), the second %s is to be replaced with the thing itself and the third with the role-name.

For example: %s '%s' already exists on role '%s'

(defn- validate-things
  ([entity component thing check-fn err-msg-fmt]
   (validate-not (check-fn (get-entity-raw entity [component]) thing)
                 (format err-msg-fmt (sets-of-things component) thing)))
  ([circle role-name component thing check-fn err-msg-fmt]
   (validate-role-updates circle role-name)
   (validate-not (check-fn (get-entity circle role-name component) thing)
                 (format err-msg-fmt (sets-of-things component) thing
                         role-name))))

Entity Generalization Functions

Adds a component to a collection without any validation.

(defn- add-to-raw
  [entity component empty-collection collection-op thing args]
  (let [things (component entity)
        entity (if things
                 entity
                 (assoc entity component empty-collection))
        add-args (into [thing] args)]
    (apply update-in entity [component] collection-op add-args)))

Generalizes an addition to any collection of things within an entity, ensuring that the given thing doesn't already exist.

(defn- add-to
  [entity component empty-collection collection-op thing & args]
  (validate-things entity component thing contains? "%s '%s' already exists")
  (add-to-raw entity component empty-collection collection-op thing args))

Add a policy to any entity.

(defn add-policy
  [entity policy-name policy-text]
  (add-to entity :policies {} assoc policy-name {:text policy-text}))

Remove a policy from an entity.

todo this looks strikingly like remove-and-purge-from-role, right? BAD.

(defn remove-policy
  [entity policy-name]
  (let [result (update-in entity [:policies] dissoc policy-name)]
    (if (empty? (:policies result))
      (assoc result :policies nil)
      result)))

Role Generalization Functions

Generalizes any role manipulation. The entities vector is the path to the entity inside the role you want to manipulate. The function given is what gets applied to the final entity, and the params are the arguments passed to that function.

(defn- update-role-raw
  [circle role-name entities function args]
  (apply update-in
         (concat [circle (simple-entity-path role-name entities) function]
           args)))

Sames as update-role-raw, but a bit easier to use. Doesn't include an entity path.

(defn- update-role
  [circle role-name function & args]
  (update-role-raw circle role-name nil function args))

Same as update-role-raw, but a bit easier to use. Includes an entity path.

(defn- update-role-entity
  [circle role-name entity-path function & args]
  (update-role-raw circle role-name entity-path function args))

Abstract function that removes a thing from a collection of things in a role in a circle. Doesn't do ANY validation. Removes the collection if it's empty. Uses the given rmfn because you could be operating on any kind of collection.

(defn- remove-and-purge-from-role
  [circle role-name component rmfn thing]
  (let [result (update-role-entity circle role-name [component] rmfn thing)]
    (if (empty? (get-entity result role-name component))
      (update-role result role-name assoc component nil)
      result)))
(defn path-to-role [path]
  (interleave (repeat :roles) path))

Generalizes any circle manipulation to unlimited subcircles. The path given is a series of role names starting from (but not including) the anchor circle. The function is what gets applied to the final subcircle, and the params are the arguments passed to that function.

(defn update-subcircle
  [circle path function & params]
  (let [update-args
        (concat [circle (path-to-role path) function] params)]
    (apply update-in update-args)))

Role manipulation

Convert the given role into a circle. Also supports converting a role inside of a circle into a circle. If the role is already a circle, expect an exception.

(defn convert-to-circle
  ([role]
   (validate-not (is-circle? role)
                 (format "Role '%s' is already a circle" (:rname role)))
   (map->Circle (into {} role)))
  ([circle role-name]
   (validate-role-updates circle role-name)
   (update-role circle role-name convert-to-circle)))

Convert the given circle into a role. If it's already not a circle, expect an exception.

(defn convert-to-role
  [circle role-name]
  (validate-role-updates circle role-name)
  (validate (is-subrole-circle? circle role-name)
            (format "Role '%s' is not a circle" role-name))
  (validate (empty? (get-entity circle role-name :roles))
            (format "Circle %s still contains roles" role-name))
  (-> circle
      (update-role role-name map->Role)
      (update-role role-name dissoc :roles :facilitator :secretary :rep-link)))

Adds a role to a circle. The role may not conflict with an existing role. new-role-name may not be empty.

(defn add-role-to-circle
  ([circle new-role-name]
   (add-role-to-circle circle new-role-name nil nil nil))
  ([circle new-role-name purpose]
   (add-role-to-circle circle new-role-name purpose nil nil))
  ([circle new-role-name purpose domains accountabilities]
   (add-role circle (Role. new-role-name purpose
                           (when (seq domains) (into (hash-set) domains))
                           (when (seq accountabilities)
                             (into (hash-set) accountabilities))
                           nil nil))))
(defn update-purpose [entity new-purpose]
  (if (empty? new-purpose)
    (assoc entity :purpose nil)
    (assoc entity :purpose new-purpose)))

Update the purpose of a role in the given circle.

(defn update-role-purpose
  [circle role-name new-purpose]
  (validate-role-updates circle role-name)
  (update-role circle role-name update-purpose new-purpose))
(defn- add-role-if-missing [circle role-name]
  (if (and (core-roles role-name)
           (role-missing? circle role-name))
    (add-role circle (map->Role {:rname role-name}))
    circle))

Very abstract function that adds things to things in a role, making sure that if a core role is being manipulated, it is made to be present. Performs collection-op on the collection, or the given empty-collection if it doesn't exist.

(defn- add-to-role
  [circle role-name component empty-collection collection-op thing & args]
  (let [circle (add-role-if-missing circle role-name)]
    (validate-things circle role-name component thing contains?
                     "%s '%s' already exists on role '%s'")
    (validate-name (sets-of-things component) thing)
    (update-in circle (entity-path role-name) add-to-raw
               component empty-collection collection-op thing args)))

Removes a thing from a collection of things in a role, making sure that if a core role is being manipulated, and becomes empty, it gets removed altogether. Performs collection-op on the collection.

(defn- remove-from-role
  [circle role-name component collection-op thing]
  (validate-things circle role-name component thing (comp not contains?)
                   "%s '%s' doesn't exist on role '%s'")
  (let [result
        (remove-and-purge-from-role circle role-name component collection-op
                                    thing)]
    (if (and (core-roles role-name)
             (every? empty? (map (partial get-entity result role-name)
                                 [:domains :accountabilities :policies])))
      (remove-role result role-name)
      result)))

Abstract function that adds anything to which-set-of-things in a role in a circle. Performs all validation and so forth. Creates the set if it doesn't exist. The sets that can be manipulated are defined in sets-of-things.

(defn- add-to-set-in-role
  [circle role-name which-set-of-things thing]
  (validate-not (is-lead-link? role-name)
                (format "May not add %s to '%s'"
                        (sets-of-things which-set-of-things) role-name))
  (add-to-role circle role-name which-set-of-things #{} conj thing))

Abstract function that removes a thing from a set-of-things in a role in a circle. Performs all validation and so forth. Removes the set if it's empty.

(defn- remove-from-set-in-role
  [circle role-name set-of-things thing]
  (remove-from-role circle role-name set-of-things disj thing))
(defn elect-to-role [circle role-name person-name expiration-date]
  (validate (core-roles role-name)
            (format "'%s' is not an elected role." role-name))
  (assoc circle (elected-role-mapping role-name)
         {:rname           person-name
          :expiration-date expiration-date}))
(defn appoint-to-role
  ([circle role-name person-name]
   (appoint-to-role circle role-name person-name nil))
  ([circle role-name person-name focus]
   (add-to-role circle role-name :assignees {} assoc person-name focus)))
(defn unappoint-from-role [circle role-name person-name]
  (validate-things circle role-name :assignees person-name (comp not contains?)
                   "%s '%s' is not in role '%s'")
  (remove-and-purge-from-role circle role-name :assignees dissoc person-name))

Role Collection Manipulation Functions

These functions are critical to maintaining namespace encapsulation. Simply allowing an external actor to call directly into the "add-to-set" and "remove-from-set" functions artificially constrains this namespace from easily being able to cause these functions to differentiate themselves from one another should they need to, adding a heavier burden on future maintainers.

Add a domain to a role in the given circle.

(defn add-role-domain
  [circle role-name domain]
  (add-to-set-in-role circle role-name :domains domain))

Remove a domain from a role in the given circle.

(defn remove-role-domain
  [circle role-name domain]
  (remove-from-set-in-role circle role-name :domains domain))

Add an accountability to a role in the given circle.

(defn add-role-accountability
  [circle role-name accountability]
  (add-to-set-in-role circle role-name :accountabilities accountability))

Remove an accountability from a role in the given circle.

(defn remove-role-accountability
  [circle role-name accountability]
  (remove-from-set-in-role circle role-name :accountabilities accountability))

Publish a policy to grant/revoke access to a domain on the given role in the given circle. If you give a domain, that will be added, too.

(defn add-role-policy
  ([circle role-name policy-name policy-text]
   (add-to-role circle role-name :policies {} assoc policy-name
                {:text policy-text}))
  ([circle role-name policy-name policy-text domain]
   (let [with-added-policy (add-role-policy circle role-name policy-name
                                            policy-text)]
     (validate (or (= (get core-role-domains role-name) domain)
                   (contains? (get-entity circle role-name :domains)
                              domain))
               (format "Role '%s' doesn't control domain '%s'" role-name
                       domain))
     (update-role-entity with-added-policy role-name [:policies policy-name]
                         assoc :domain domain))))

Remove a policy from a role in the given circle.

(defn remove-role-policy
  [circle role-name policy-name]
  (remove-from-role circle role-name :policies dissoc policy-name))
 
(ns freefrog.lang
  (:require [clj-time.format :as f]
            [clojure.java.io :as io]
            [clojure.tools.logging :as log]
            [freefrog.governance :as g]
            [instaparse.core :as insta])
  (:import (freefrog GovernanceParseException)))

Note: this function may show up as unused in IntelliJ but it is because metaprogramming!

(defn create-anchor-circle [_ {:keys [name cross-links purpose]}]
  (let [anchor-circle (-> name
                          g/create-circle
                          (g/update-purpose purpose))]
    (reduce g/add-role-to-circle
            anchor-circle
            cross-links)))
(defn create-role [circle {:keys [name purpose domains accountabilities]}]
  (g/add-role-to-circle circle name purpose domains accountabilities))
(defn create-circle [circle {:keys [name purpose domains accountabilities]}]
  (g/convert-to-circle
    (g/add-role-to-circle circle name purpose domains accountabilities)
    name))

TODO this function needs test coverage besides the smoke test!

(defn delete-role [circle {:keys [name]}]
  (g/remove-role circle name))
(defn get-conversion-object [params]
  (-> params (dissoc :name) keys first name))
(defn convert-with-validation [anchor-circle conversion-fn
                              expected-object error-fmt
                               {:keys [name] :as params}]
  (let [conversion-object (get-conversion-object params)]
    (if (= expected-object conversion-object)
      (conversion-fn anchor-circle name)
      (throw (GovernanceParseException.
               (format error-fmt conversion-object))))))

Note: this function may show up as unused in IntelliJ but it is because metaprogramming!

(defn convert-role [anchor-circle params]
  (convert-with-validation anchor-circle g/convert-to-circle
                           "circle" "Cannot convert role into a %s." params))
(defn convert-circle [anchor-circle params]
  (convert-with-validation anchor-circle g/convert-to-role
                           "role" "Cannot convert circle into a %s." params))
(defn update-purpose-conditionally [anchor-circle circle-name [purpose]]
  (if purpose
    (g/update-role-purpose anchor-circle circle-name purpose)
    anchor-circle))
(defn rename-conditionally [anchor-circle old-name [new-name]]
  (if new-name
    (g/rename-role anchor-circle old-name new-name)
    anchor-circle))
(def update-conversions {:accountabilities "accountability"
                         :domains          "domain"})
(defn apply-collection-update [circle role-name update-type
                               [component & params]]
  (let [function-name (format "%s-role-%s"
                              update-type (update-conversions component))
        fn (resolve (symbol "freefrog.governance" function-name))]
    (reduce #(fn %1 role-name %2) circle params)))
(defn apply-collection-updates [circle role-name update-type ops]
  (reduce #(apply-collection-update %1 role-name update-type %2) circle ops))
(defn update-role [circle
                   {:keys [name rename change-purpose add remove]}]
  (-> circle
      (apply-collection-updates name "add" add)
      (apply-collection-updates name "remove" remove)
      (update-purpose-conditionally name change-purpose)
      (rename-conditionally name rename)))
(def update-circle update-role)

Convert the given vector into a key/value pair. The first value of the vector is the first value, whereas the rest is the second value as a vector. Unless the key is :purpose, in which case the value will be just the second value.

(defn- convert-to-pair
  [v]
  (if (= :purpose (first v))
    [(first v) (second v)]
    [(first v) (rest v)]))
(defn array-to-map [v] {(first v) (second v)})
(defn merge-array-values [v] (apply merge-with (concat [concat] v)))
(defn execute-governance-function [record function circle params]
  (try (function circle params)
       (catch GovernanceParseException ge (throw ge))
       (catch Exception e
         (throw
           (RuntimeException.
             (format "Unable to execute governance record: %s " record) e)))))
(defn modify-entity [circle [_ [function-secondary] entity-name :as record]
                     function-primary]
  (let [function-name (format "%s-%s"
                              (name function-primary) (name function-secondary))
        fn (resolve (symbol "freefrog.lang" function-name))
        params (->> record
                    (drop 3)
                    (map convert-to-pair)
                    (map array-to-map)
                    merge-array-values
                    (merge {:name entity-name}))]
    (execute-governance-function record fn circle params)))
(defn define-policy [circle [_ policy-name policy-text] _]
  (g/add-policy circle policy-name policy-text))
(defn strike-policy [circle [_ policy-name] _]
  (g/remove-policy circle policy-name))
(def elected-role-mapping {"facilitator" g/facilitator-name
                           "secretary"   g/secretary-name
                           "rep link"    g/rep-link-name})
(def formatter (f/formatter "yyyy-MM-dd"))
(defn elect [circle [_ person-name role-name expiration] _]
  (g/elect-to-role circle (elected-role-mapping role-name)
                   person-name (f/parse formatter expiration)))
(defn appoint [circle [_ person-name role-name focus] _]
  (g/appoint-to-role circle role-name person-name focus))
(defn unappoint [circle [_ person-name role-name] _]
  (g/unappoint-from-role circle role-name person-name))
(def commands {:create    modify-entity
               :delete    modify-entity
               :update    modify-entity
               :convert   modify-entity
               :define    define-policy
               :strike    strike-policy
               :elect     elect
               :appoint   appoint
               :unappoint unappoint})

Execute the given governance transformation on the given circle, returning the new circle.

(defn process-command
  [circle [function-primary :as record]]
  (let [command (function-primary commands)]
    (if command
      (command circle record function-primary)
      (do
        (log/warnf "Can't handle this record yet: %s" record)
        circle))))

Parse a governance document and produce a tree from it.

(def parse-governance
  (insta/parser (io/resource "governance.ebnf") :string-ci true))

Take a governance string and execute the transformations it represents.

(defn execute-governance
  ([governance-string]
   (execute-governance nil governance-string))
  ([circle governance-string]
   (let [parsed-document (parse-governance governance-string)]
     (if (insta/failure? parsed-document)
       (throw (GovernanceParseException. (pr-str parsed-document)))
       (let [process-document (partial reduce process-command)
             first-command (first parsed-document)]
         (if (= :govern (first first-command))
           (g/update-subcircle circle (rest first-command)
                               process-document (rest parsed-document))
           (process-document circle parsed-document)))))))

Run a directory full of files as if they were governance of a brand new organization

(defn execute-directory
  [directory]
  (log/debugf "Executing governance in directory: %s" directory)
  (->> directory
       io/file
       file-seq
       (filter #(.isFile %))
       (filter #(not (.startsWith (.getName %) ".")))
       (sort-by #(.getName %))
       (reduce (fn [circle governance-file]
                 (log/debugf "Executing: %s" (.getName governance-file))
                 (execute-governance circle (slurp governance-file))) {})))
 
(ns freefrog.render
  (:require [freefrog.governance :as g]
            [selmer.parser :as p]
            [selmer.filters :as f]))
(defn reduce-to-names-with-indices [circle which-collection]
  (update-in circle [which-collection]
             #(->> %
                   (into (sorted-map))
                   (map-indexed (fn [idx item] {:idx idx :name (key item)})))))
(defn make-role-renderable [circle]
  (-> circle
      (reduce-to-names-with-indices :policies)
      (reduce-to-names-with-indices :roles)))
(f/add-filter! :present? seq)
(def role-template
  (str "# {{rname}} #\n"
       "{% if purpose|not-empty %}{{purpose}}\n{% endif %}"
       "{% if any facilitator secretary%}\n{% endif %}"
       "{% if facilitator|not-empty %}Facilitator: {{facilitator.rname}},"
       " expiring "
       "{{facilitator.expiration-date|date:\"yyyy-MM-dd\"}}\n"
       "{% endif %}"
       "{% if secretary|not-empty %}Secretary: {{secretary.rname}},"
       " expiring "
       "{{secretary.expiration-date|date:\"yyyy-MM-dd\"}}\n"
       "{% endif %}"
       "{% if domains|present? %}\n## Domains ##\n\n"
       "{% for x in domains %}  * {{x}}\n{% endfor %}{% endif %}"
       "{% if accountabilities|present? %}\n## Accountabilities ##\n\n"
       "{% for x in accountabilities %}  * {{x}}\n{% endfor %}{% endif %}"
       "{% if policies|present? %}\n## Policies ##\n\n"
       "{% for x in policies %}  {{x.idx}}. {{x.name}}\n{% endfor %}"
       "{% endif %}"
       "{% if roles|present? %}\n## Roles ##\n\n"
       "{% for x in roles %}  {{x.idx}}. {{x.name}}\n{% endfor %}{% endif %}"
       "{% if assignees|present? %}\n## Assignees ##\n\n"
       "{% for x in assignees %}  * {{x|first}}"
       "{% if x|last|not-empty %}, for {{x|last}} {% endif %}\n"
       "{% endfor %}{% endif %}"))
(defn markdown-role [role]
  (p/render role-template (make-role-renderable role)))
 

Circle Manipulation Spec

Defines how circles may be updated.

(ns freefrog.governance-circles-spec
  (:require [freefrog.governance :as g]
            [freefrog.governance-spec-helpers :refer :all]
            [speclj.core :refer :all]
            [clj-time.core :as t])
  (:import (java.lang IllegalArgumentException)))
(def sample-anchor-with-sample-policy
  (my-add-policy sample-anchor-with-role "test" "stuff"))

Section 2.1

(describe "Circles"
  (it "can create a circle"
    (should= (g/map->Circle {:rname "Courage Labs"})
      (g/create-circle "Courage Labs")))

  (it "doesn't work with an empty name"
    (should-throw IllegalArgumentException "Circle name may not be empty"
      (g/create-circle nil))
    (should-throw IllegalArgumentException "Circle name may not be empty"
      (g/create-circle "")))

  (it "can tell you if a role is authorized to act as a circle"
    (should (g/is-circle? sample-anchor-with-role))
    (should-not (g/is-subrole-circle? sample-anchor-with-role role-name)))

  (it "can convert a role into a circle"
    (should (g/is-subrole-circle?
              (g/convert-to-circle sample-anchor-with-role role-name)
              role-name)))

  (it "refuses to convert a role that is already a circle into a circle"
    (should-throw IllegalArgumentException
      (format "Role '%s' is already a circle" role-name)
      (-> sample-anchor-with-role
          (g/convert-to-circle role-name)
          (g/convert-to-circle role-name))))

  (it "can convert an empty circle back into a role"
    (should (.equals sample-anchor-with-role
                     (-> sample-anchor-with-role
                         (g/convert-to-circle role-name)
                         (g/convert-to-role role-name)))))

  (it "refuses to convert a non-empty circle into a role"
    (should-throw IllegalArgumentException
      (format "Circle %s still contains roles" role-name)
      (let [circle-with-full-subcircle
            (-> sample-anchor-with-role
                (g/convert-to-circle role-name)
                (g/update-subcircle [role-name] g/add-role-to-circle
                                    "Fun"))]
        (g/convert-to-role circle-with-full-subcircle role-name))))

  (it "refuses to convert a role that isn't a circle into a role"
    (should-throw IllegalArgumentException
      (format "Role '%s' is not a circle" role-name)
      (g/convert-to-role sample-anchor-with-role role-name)))

  (should-not-update-missing-or-empty-roles g/convert-to-circle
    "convert to circle")
  (should-not-update-missing-or-empty-roles g/convert-to-role
    "convert to role")

  ;; TODO unify this with the role-specific code because there is a TON
  ;; of validation and behavior in there
  (describe "policies"
    (describe "adding"
      (it "can add to a circle with no policies"
        (should= sample-anchor-with-sample-policy
          (g/add-policy sample-anchor-with-role "test" "stuff"))))

    (describe "removing"
      (it "can remove a policy from a circle"
        (should= sample-anchor-with-role
          (g/remove-policy sample-anchor-with-sample-policy "test"))))))
(def sample-policy-name "Do whatever")
(def sample-policy-text "Anybody can do anything whenever")
(def sample-policies-lead-link {sample-policy-name
                                {:domain g/role-assignments-domain
                                 :text   sample-policy-text}})
(def sample-policies-secretary {sample-policy-name
                                {:domain g/governance-records-domain
                                 :text   sample-policy-text}})
(def sample-policy-name2 "Do things to other people")
(def sample-policy-text2 "Anybody do things to anyone else")
(def sample-anchor-with-lead-link-policy
  (g/add-role-policy sample-anchor g/lead-link-name sample-policy-name
                     sample-policy-text g/role-assignments-domain))
(def sample-anchor-with-lead-link-policies
  (g/add-role-policy sample-anchor-with-lead-link-policy g/lead-link-name
                     sample-policy-name2 sample-policy-text2))
(def sample-anchor-with-secretary-policy
  (g/add-role-policy sample-anchor g/secretary-name sample-policy-name
                     sample-policy-text g/governance-records-domain))
(def sample-anchor-with-secretary-policies
  (g/add-role-policy sample-anchor-with-secretary-policy g/secretary-name
                     sample-policy-name2 sample-policy-text2))

Section 2.2.3

(describe "Lead Link Role"
  (it "won't add domains to the Lead Link"
    (should-throw IllegalArgumentException
      (format "May not add Domain to '%s'" g/lead-link-name)
      (g/add-role-domain sample-anchor g/lead-link-name "test"))

    (should-throw IllegalArgumentException
      (format "May not add Domain to '%s'" g/lead-link-name)
      (g/add-role-domain sample-anchor-with-lead-link-policy
                         g/lead-link-name "test")))

  (it "won't add accountabilities to the Lead Link"
    (should-throw IllegalArgumentException
      (format "May not add Accountability to '%s'" g/lead-link-name)
      (g/add-role-accountability sample-anchor g/lead-link-name "test"))

    (should-throw IllegalArgumentException
      (format "May not add Accountability to '%s'" g/lead-link-name)
      (g/add-role-accountability sample-anchor-with-lead-link-policy
                                 g/lead-link-name "test")))

  (describe "adding policies"
    (it "can delegate a predefined domain from Lead Link"
      (should=
        (update-in sample-anchor [:roles] assoc g/lead-link-name
                   (g/map->Role {:rname    g/lead-link-name
                                 :policies sample-policies-lead-link}))
        sample-anchor-with-lead-link-policy))

    (it "won't create policies for domains Lead Link doesn't have"
      (should-throw IllegalArgumentException
        "Role 'Lead Link' doesn't control domain 'domain it doesn't have'"
        (g/add-role-policy sample-anchor g/lead-link-name sample-policy-name
                           sample-policy-text "domain it doesn't have")))

    (it "can create multiple policies"
      (should=
        (update-in sample-anchor [:roles] assoc g/lead-link-name
                   (g/map->Role {:rname g/lead-link-name
                                 :policies
                                        (assoc sample-policies-lead-link
                                               sample-policy-name2
                                               {:text sample-policy-text2})}))
        sample-anchor-with-lead-link-policies)))

  (describe "removing policies"
    (it "removes Lead Link when it is empty"
      (should= sample-anchor
        (g/remove-role-policy sample-anchor-with-lead-link-policy
                              g/lead-link-name sample-policy-name)))

    (it "doesn't remove Lead Link when it isn't empty"
      (should= sample-anchor-with-lead-link-policy
        (g/remove-role-policy sample-anchor-with-lead-link-policies
                              g/lead-link-name sample-policy-name2)))))
(def sample-domain1 "stuff")
(def sample-domain2 "bits")
(def sample-anchor-with-secretary-with-domain
  (g/add-role-domain sample-anchor g/secretary-name sample-domain1))
(def sample-anchor-with-secretary-with-domains
  (g/add-role-domain sample-anchor-with-secretary-with-domain
                     g/secretary-name sample-domain2))
(def sample-anchor-with-facilitator-with-domain
  (g/add-role-domain sample-anchor g/facilitator-name sample-domain1))
(def sample-anchor-with-facilitator-with-domains
  (g/add-role-domain sample-anchor-with-facilitator-with-domain
                     g/facilitator-name sample-domain2))
(def sample-anchor-with-rep-link-with-domain
  (g/add-role-domain sample-anchor g/rep-link-name sample-domain1))
(def sample-anchor-with-rep-link-with-domains
  (g/add-role-domain sample-anchor-with-rep-link-with-domain
                     g/rep-link-name sample-domain2))
(def sample-acc1 "doing stuff")
(def sample-acc2 "doing bits")
(def sample-anchor-with-secretary-with-acc
  (g/add-role-accountability sample-anchor g/secretary-name sample-acc1))
(def sample-anchor-with-secretary-with-accs
  (g/add-role-accountability sample-anchor-with-secretary-with-acc
                             g/secretary-name sample-acc2))
(def sample-anchor-with-facilitator-with-acc
  (g/add-role-accountability sample-anchor g/facilitator-name sample-acc1))
(def sample-anchor-with-facilitator-with-accs
  (g/add-role-accountability sample-anchor-with-facilitator-with-acc
                             g/facilitator-name sample-acc2))
(def sample-anchor-with-rep-link-with-acc
  (g/add-role-accountability sample-anchor g/rep-link-name sample-acc1))
(def sample-anchor-with-rep-link-with-accs
  (g/add-role-accountability sample-anchor-with-rep-link-with-acc
                             g/rep-link-name sample-acc2))
(def sample-anchor-with-rep-link-with-acc-and-domain
  (g/add-role-domain sample-anchor-with-rep-link-with-acc
                     g/rep-link-name sample-domain1))
(defn- should-manipulate-things-in-core-role
  [role-name description which-things sample-with-one sample-with-two first
   second removal-fn]
  (describe (format "%s %s" role-name description)
    (it "can add one"
      (should= (update-in sample-anchor [:roles] assoc role-name
                          (g/map->Role {:rname       role-name
                                        which-things #{first}}))
        sample-with-one))
    (it "can add second one"
      (should= (update-in sample-with-one
                          [:roles role-name which-things] conj
                          second)
        sample-with-two))
    (it "removes role when last one is removed"
      (should= sample-anchor
        (removal-fn sample-with-one role-name first)))
    (it "doesn't remove role when second-to-last one is removed"
      (should= sample-with-one
        (removal-fn sample-with-two role-name second)))))

Section 2.4

(let [assignee-name "larry"
      focus-assignee-name "george"
      sample-anchor-with-assignee
      (g/appoint-to-role sample-anchor-with-two-roles tester-role
                         assignee-name)

      sample-anchor-with-assignee-with-focus
      (g/appoint-to-role sample-anchor-with-role role-name focus-assignee-name
                         "cool stuff")]

  (describe "Role Appointment"
    (it "can appoint someone to a role"
      (should= (update-in sample-anchor-with-role
                          [:roles role-name] assoc :assignees
                          {"susan" nil})
        (g/appoint-to-role sample-anchor-with-role role-name "susan"))

      (should= (update-in sample-anchor-with-two-roles
                          [:roles tester-role] assoc :assignees
                          {"larry" nil})
        sample-anchor-with-assignee)

      (should= (update-in sample-anchor-with-assignee
                          [:roles tester-role :assignees] assoc
                          "jane" nil)
        (g/appoint-to-role sample-anchor-with-assignee tester-role "jane")))

    (it "can appoint someone to a role with a focus"
      (should= (update-in sample-anchor-with-role
                          [:roles role-name] assoc :assignees
                          {focus-assignee-name "cool stuff"})
        sample-anchor-with-assignee-with-focus))

    (it "can remove someone from a role"
      (should= sample-anchor-with-two-roles
        (g/unappoint-from-role sample-anchor-with-assignee tester-role
                               assignee-name)))

    (should-not-update-missing-or-empty-roles g/appoint-to-role
      "role assignment" "june")

    (should-not-update-missing-or-empty-roles g/appoint-to-role
      "role assignment" "june" "some focus")

    (should-not-update-missing-or-empty-roles g/unappoint-from-role
      "role unassignment" "june")

    (it "won't appoint nil to a role"
      (should-throw IllegalArgumentException
        "Person name may not be empty"
        (g/appoint-to-role sample-anchor-with-role role-name nil)))

    (it "won't unappoint someone who wasn't in the role"
      (should-throw IllegalArgumentException
        (format "Person 'june' is not in role '%s'" tester-role)
        (g/unappoint-from-role sample-anchor-with-assignee tester-role
                               "june")))))

Section 2.5

(describe "Elected Roles"
  ;; Section 2.5.2

  (let [expiration-date (t/date-time 2014 01 01)]
    (describe "holding elections"
      (it "can't elect someone to a non-core role"
        (should-throw IllegalArgumentException
          (format "'%s' is not an elected role." role-name)
          (g/elect-to-role sample-anchor-with-role role-name "bill"
                           expiration-date)))
      (it "can specify that an elected role has had someone elected to it
       and when their term expires"
        (should= (assoc sample-anchor :facilitator
                        {:rname           "bill"
                         :expiration-date expiration-date})
          (g/elect-to-role sample-anchor g/facilitator-name "bill"
                           expiration-date))

        (should= (assoc sample-anchor :secretary
                        {:rname           "mary"
                         :expiration-date expiration-date})
          (g/elect-to-role sample-anchor g/secretary-name "mary"
                           expiration-date))

        (should= (assoc sample-anchor :rep-link
                        {:rname           "mary"
                         :expiration-date expiration-date})
          (g/elect-to-role sample-anchor g/rep-link-name "mary"
                           expiration-date)))))

  ;; Section 2.5.3
  (should-manipulate-things-in-core-role
    g/secretary-name "domains"
    :domains sample-anchor-with-secretary-with-domain
    sample-anchor-with-secretary-with-domains
    sample-domain1 sample-domain2 g/remove-role-domain)

  (should-manipulate-things-in-core-role
    g/secretary-name "accountabilities"
    :accountabilities sample-anchor-with-secretary-with-acc
    sample-anchor-with-secretary-with-accs
    sample-acc1 sample-acc2 g/remove-role-accountability)

  (should-manipulate-things-in-core-role
    g/facilitator-name "domains"
    :domains sample-anchor-with-facilitator-with-domain
    sample-anchor-with-facilitator-with-domains
    sample-domain1 sample-domain2 g/remove-role-domain)

  (should-manipulate-things-in-core-role
    g/facilitator-name "accountabilities"
    :accountabilities sample-anchor-with-facilitator-with-acc
    sample-anchor-with-facilitator-with-accs
    sample-acc1 sample-acc2 g/remove-role-accountability)

  (should-manipulate-things-in-core-role
    g/rep-link-name "domains"
    :domains sample-anchor-with-rep-link-with-domain
    sample-anchor-with-rep-link-with-domains
    sample-domain1 sample-domain2 g/remove-role-domain)

  (should-manipulate-things-in-core-role
    g/rep-link-name "accountabilities"
    :accountabilities sample-anchor-with-rep-link-with-acc
    sample-anchor-with-rep-link-with-accs
    sample-acc1 sample-acc2 g/remove-role-accountability)

  (it "doesn't remove core role when manipulating one collection among many"
    (should= sample-anchor-with-rep-link-with-acc
      (g/remove-role-domain sample-anchor-with-rep-link-with-acc-and-domain
                            g/rep-link-name sample-domain1)))

  (describe "Adding policies"
    (it "can delegate a predefined domain from Secretary"
      (should=
        (update-in sample-anchor [:roles] assoc g/secretary-name
                   (g/map->Role {:rname    g/secretary-name
                                 :policies sample-policies-secretary}))
        sample-anchor-with-secretary-policy))

    (it "won't create policies for domains Lead Link doesn't have"
      (should-throw IllegalArgumentException
        "Role 'Secretary' doesn't control domain 'domain it doesn't have'"
        (g/add-role-policy sample-anchor g/secretary-name sample-policy-name
                           sample-policy-text "domain it doesn't have")))

    (it "can create multiple policies"
      (should=
        (update-in sample-anchor [:roles] assoc g/secretary-name
                   (g/map->Role {:rname g/secretary-name
                                 :policies
                                        (assoc sample-policies-secretary
                                               sample-policy-name2
                                               {:text sample-policy-text2})}))
        sample-anchor-with-secretary-policies)))

  (describe "removing policies"
    (it "removes Secretary when it is empty"
      (should= sample-anchor
        (g/remove-role-policy sample-anchor-with-secretary-policy
                              g/secretary-name sample-policy-name)))

    (it "doesn't remove Secretary when it isn't empty"
      (should= sample-anchor-with-secretary-policy
        (g/remove-role-policy sample-anchor-with-secretary-policies
                              g/secretary-name sample-policy-name2)))))
(def subcircle-name "Development")
(def subcircle-role-name "Programmer")
(def subcircle-role-purpose "Coding")
(def circle-with-subcircle
  (-> sample-anchor
      (g/add-role-to-circle subcircle-name "Great software")
      (g/convert-to-circle subcircle-name)))
(def circle-with-subrole
  (g/update-subcircle circle-with-subcircle [subcircle-name]
                      g/add-role-to-circle role-name
                      subcircle-role-purpose))
(describe "Subcircle manipulation"
  (it "can add a role to a subcircle"
    (let [expected (update-in circle-with-subcircle [:roles subcircle-name]
                              g/add-role-to-circle subcircle-role-name
                              subcircle-role-purpose)
          actual (g/update-subcircle circle-with-subcircle [subcircle-name]
                                     g/add-role-to-circle subcircle-role-name
                                     subcircle-role-purpose)]
      (should= expected actual)))

  (it "can remove a role from a subcircle"
    (should= circle-with-subcircle (g/update-subcircle
                                     circle-with-subrole
                                     [subcircle-name] g/remove-role
                                     subcircle-role-name)))

  (it "can manipulate a deeply-nested structure"
    (let [expected
          (update-in circle-with-subrole [:roles subcircle-name :roles
                                          subcircle-role-name]
                     g/convert-to-circle)

          actual
          (g/update-subcircle circle-with-subrole [subcircle-name
                                                   subcircle-role-name]
                              g/convert-to-circle)]
      (should= expected actual))))
(run-specs)
 

Role Manipulation Spec

Defines how all roles can be manipulated, both through governance (maintenance and elections) and through the normal business of appointment/removal.

(ns freefrog.governance-roles-spec
  (:require [clojure.set :as s]
            [freefrog.governance :as g]
            [freefrog.governance-spec-helpers :refer :all]
            [speclj.core :refer :all]))
(def sample-domain-1 "Code")
(def sample-domain-2 "Tests")
(def sample-domains #{sample-domain-1 sample-domain-2})
(def sample-anchor-with-domain
  (g/add-role-domain sample-anchor-with-role role-name sample-domain-1))
(def sample-anchor-with-domains
  (g/add-role-domain sample-anchor-with-domain role-name sample-domain-2))
(def sample-acc-1 "Writing Code")
(def sample-acc-2 "Testing their own stuff")
(def sample-accountabilities #{sample-acc-1 sample-acc-2})
(def sample-anchor-with-acc
  (g/add-role-accountability sample-anchor-with-role role-name sample-acc-1))
(def sample-anchor-with-accs
  (-> sample-anchor-with-role (g/add-role-accountability role-name sample-acc-1)
      (g/add-role-accountability role-name sample-acc-2)))
(defn- should-handle-collection-properly [add-fn remove-fn type type-str coll1
                                          coll2 val1 val2]
  (describe type-str
    (it (str "can add a " type-str " to a role with no " type-str "s")
      (should= (update-in sample-anchor-with-role [:roles role-name]
                          assoc type #{val1})
        (add-fn sample-anchor-with-role role-name val1)))
    (it (str "can add a " type-str " to a role with existing " type-str "s")
      (let [expected
            (update-in coll1 [:roles role-name type] conj val2)]
        (should= expected
          (add-fn coll1 role-name val2))))
    (it (str "won't add nil to a " type-str)
      (should-throw IllegalArgumentException
        (str type-str " name may not be empty")
        (add-fn sample-anchor-with-role role-name nil)))
    (should-not-update-missing-or-empty-roles add-fn
      (str "adding a " type-str) val1)
    (it (str "won't add the same " type-str " twice")
      (should-throw IllegalArgumentException
        (format "%s '%s' already exists on role '%s'" type-str val1 role-name)
        (add-fn coll1 role-name val1)))
    (it (str "can remove a " type-str " from a role")
      (should= coll1 (remove-fn coll2 role-name val2)))
    (it (str "removes the " type-str "s array when there are none left")
      (should= sample-anchor-with-role (remove-fn coll1 role-name val1)))
    (it (str "won't remove a " type-str " that doesn't exist")
      (should-throw IllegalArgumentException
        (format "%s '%s' doesn't exist on role '%s'" type-str val2 role-name)
        (remove-fn coll1 role-name val2)))
    (should-not-update-missing-or-empty-roles remove-fn
      (str "removing a " type-str) val1)))

Section 3.1.a

(describe "Role Manipulation"
  (describe "adding"
    (it "can add a role to a circle with name and purpose"
      (should (.equals (assoc sample-anchor :roles
                              {role-name
                               (g/map->Role {:rname   role-name
                                             :purpose sample-purpose})})
                       sample-anchor-with-role)))
    (it "can add a role to a circle that already has roles"
      (let [second-role-name "Tester"
            second-role-purpose "Making sure Programmers don't screw up"]
        (should
          (.equals (update-in sample-anchor-with-role [:roles] assoc
                              second-role-name
                              (g/map->Role {:rname   second-role-name
                                            :purpose second-role-purpose}))
                   (g/add-role-to-circle sample-anchor-with-role
                                         second-role-name
                                         second-role-purpose)))))
    (it "can add a role to a circle with name and accountabilities"
      (should
        (.equals (assoc sample-anchor :roles
                        {role-name
                         (g/map->Role
                           {:rname            role-name
                            :accountabilities sample-accountabilities})})
                 (g/add-role-to-circle sample-anchor role-name
                                       nil nil sample-accountabilities))))
    (it "can add a role to a circle with name, purpose, and domains"
      (should
        (.equals (assoc sample-anchor :roles
                        {role-name
                         (g/map->Role {:rname   role-name
                                       :domains sample-domains})})
                 (g/add-role-to-circle sample-anchor role-name nil
                                       sample-domains nil))))
    (it "can add a role to a circle with name, purpose, and accountabilities"
      (should
        (.equals (assoc sample-anchor :roles
                        {role-name
                         (g/map->Role {:rname   role-name
                                       :domains sample-domains})})
                 (g/add-role-to-circle sample-anchor role-name nil
                                       sample-domains nil))))
    (it "can add a role to a circle with everything"
      (should (.equals (assoc sample-anchor
                              :roles
                              {role-name
                               (g/map->Role
                                 {:rname            role-name
                                  :purpose          sample-purpose
                                  :domains          sample-domains
                                  :accountabilities sample-accountabilities})})
                       (g/add-role-to-circle sample-anchor role-name
                                             sample-purpose sample-domains
                                             sample-accountabilities))))
    (it "doesn't let you use empty names"
      (should-throw IllegalArgumentException "Role name may not be empty"
        (g/add-role-to-circle sample-anchor nil nil nil nil))
      (should-throw IllegalArgumentException "Role name may not be empty"
        (g/add-role-to-circle sample-anchor  nil nil nil)))
    (it "doesn't let you overwrite an existing role"
      (should-throw IllegalArgumentException (str "Role already exists: "
                                                  role-name)
        (g/add-role-to-circle sample-anchor-with-role role-name nil nil nil))))
  (describe "removing"
    (it "can remove a role"
      (should= sample-anchor-with-role (-> sample-anchor-with-role
                                           (g/add-role-to-circle "test" "test")
                                           (g/remove-role "test"))))
    (it "removes the roles array if deleting a role causes it to be empty"
      (should= sample-anchor (g/remove-role sample-anchor-with-role role-name)))
    (should-not-update-missing-or-empty-roles g/remove-role "role itself"))
  (def new-name "Code Monkey")
  (describe "updating"
    (describe "name"
      (it "can rename a role"
        (should= (-> sample-anchor-with-role
                     (update-in [:roles] s/rename-keys {role-name new-name})
                     (update-in [:roles new-name] assoc :rname new-name))
          (g/rename-role sample-anchor-with-role role-name new-name)))
      (should-not-update-missing-or-empty-roles g/rename-role "renaming role"
        new-name))
    ;; Section 1.1.a
    (describe "purpose"
      (it "can change a role's purpose"
        (let [new-purpose "Building software that's grrreat!"]
          (should= (update-in sample-anchor-with-role [:roles role-name]
                              assoc :purpose new-purpose)
            (g/update-role-purpose sample-anchor-with-role role-name
                                   new-purpose))))
      (it "can clear a role's purpose"
        (should= (update-in sample-anchor-with-role [:roles role-name] assoc
                            :purpose nil)
          (g/update-role-purpose sample-anchor-with-role role-name nil))
        (should= (update-in sample-anchor-with-role [:roles role-name] assoc
                            :purpose nil)
          (g/update-role-purpose sample-anchor-with-role role-name )))
      (should-not-update-missing-or-empty-roles g/update-role-purpose
        "updating purpose" "Stuff"))
    ;; Section 1.1.b
    (should-handle-collection-properly g/add-role-domain
                                       g/remove-role-domain
                                       :domains "Domain"
                                       sample-anchor-with-domain
                                       sample-anchor-with-domains
                                       sample-domain-1
                                       sample-domain-2)
    ;; Section 1.1.c
    (should-handle-collection-properly g/add-role-accountability
                                       g/remove-role-accountability
                                       :accountabilities "Accountability"
                                       sample-anchor-with-acc
                                       sample-anchor-with-accs
                                       sample-acc-1
                                       sample-acc-2)))
(def sample-policy-name "Pull requests")
(def sample-policy-text "You gotta use pull requests to contribute any code.")
(def sample-policy2-name "Straight to Master")
(def sample-policy2-text "Just tell someone what the commit has was.")
(def sample-anchor-with-policy (g/add-role-policy sample-anchor-with-domain
                                                  role-name sample-policy-name
                                                  sample-policy-text))
(def sample-anchor-with-policies (g/add-role-policy sample-anchor-with-policy
                                                    role-name
                                                    sample-policy2-name
                                                    sample-policy2-text))

Section 1.3

(describe "policies"
  (should-not-update-missing-or-empty-roles g/add-role-policy "policy"
    sample-policy-name sample-policy-text)
  (should-not-update-missing-or-empty-roles g/add-role-policy "policy"
    sample-policy-name
    sample-policy-text sample-domain-1)
  (it "can add a policy granting access to all domains"
    (should= (my-add-policy sample-anchor-with-domain role-name
                            sample-policy-name sample-policy-text)
      sample-anchor-with-policy)
    (should= (my-add-policy sample-anchor-with-policy role-name
                            sample-policy2-name sample-policy2-text)
      (g/add-role-policy sample-anchor-with-policy role-name
                         sample-policy2-name sample-policy2-text)))

  (it "can add a policy granting access to a domain"
    (should= (my-add-policy sample-anchor-with-domain role-name
                            sample-policy-name sample-policy-text
                            sample-domain-1)
      (g/add-role-policy sample-anchor-with-domain role-name
                         sample-policy-name sample-policy-text
                         sample-domain-1)))
  (it (str "won't add a policy granting access to a domain that the role"
           "doesn't control")
    (should-throw IllegalArgumentException
      (format "Role '%s' doesn't control domain '%s'" role-name sample-domain-2)
      (g/add-role-policy sample-anchor-with-domain role-name
                         "Don't test my stuff!" "Only I can test stuff"
                         sample-domain-2)))
  (it "won't add a policy with the same name as one that already exists"
    (should-throw IllegalArgumentException
      (format "Policy '%s' already exists on role '%s'" sample-policy-name
              role-name)
      (g/add-role-policy sample-anchor-with-policy role-name sample-policy-name
                         "More coding stuff!")))

  (should-not-update-missing-or-empty-roles g/remove-role-policy "policy"
    sample-policy-name)

  (it "can remove a policy"
    (should= sample-anchor-with-policy
      (g/remove-role-policy sample-anchor-with-policies role-name
                            sample-policy2-name))
    (should= sample-anchor-with-domain
      (g/remove-role-policy sample-anchor-with-policy role-name
                            sample-policy-name)))
  (it "won't remove a policy that doesn't exist"
    (should-throw IllegalArgumentException
      (format "Policy '%s' doesn't exist on role '%s'" sample-policy-name
              role-name)
      (g/remove-role-policy sample-anchor-with-domain role-name
                            sample-policy-name))))
(run-specs)
 
(ns freefrog.governance-spec-helpers
  (:require [freefrog.governance :as g]
            [speclj.core :refer :all]))
(def sample-anchor (g/create-circle "Amazing Corp"))
(def role-name "Programmer")
(def tester-role "Tester")
(def sample-purpose "Building awesome software")
(def sample-anchor-with-role (g/add-role-to-circle sample-anchor role-name
                                                   sample-purpose))
(def sample-anchor-with-two-roles
  (g/add-role-to-circle sample-anchor-with-role tester-role))
(defn my-add-policy
  ([circle name text]
   (update-in circle [:policies]
              assoc name {:text text}))
  ([circle role-name name text]
   (update-in circle [:roles role-name :policies]
              assoc name {:text text}))
  ([circle role-name name text domain]
   (update-in (my-add-policy circle role-name name text)
              [:roles role-name :policies name] assoc :domain domain)))
(defn should-not-update-missing-or-empty-roles [fn type-str & params]
  (describe (format "%s problems" type-str)
    (it "doesn't work with a role that doesn't exist"
      (should-throw IllegalArgumentException (str "Role not found: "
                                                  role-name)
        (apply fn (concat [sample-anchor role-name] params))))
    (it "doesn't work with an empty name"
      (should-throw IllegalArgumentException "Role name may not be empty"
        (apply fn (concat [sample-anchor-with-role nil] params)))
      (should-throw IllegalArgumentException "Role name may not be empty"
        (apply fn (concat [sample-anchor-with-role ] params))))))
 
(ns freefrog.lang-spec
  (:require [clj-yaml.core :as yaml]
            [clj-time.core :as t]
            [freefrog.governance :as g]
            [freefrog.lang :as l]
            [speclj.core :refer :all])
  (:import (freefrog GovernanceParseException)))

Monkey patch clj-yaml to do nice encoding of dates and defrecords

(ns clj-yaml.core
  (:require [clj-time.format :as f]))
(defn encode-without-nils [data]
  (encode (into {} (remove (comp nil? second) data))))
(extend-protocol YAMLCodec
  freefrog.governance.Role
  (encode [data] (encode-without-nils data))

  freefrog.governance.Circle
  (encode [data] (encode-without-nils data))

  org.joda.time.DateTime
  (encode [data]
    (f/unparse (f/formatters :date) data)))
(ns freefrog.lang-spec)
(defn governance [name]
  (slurp (str "spec/freefrog/lang/" name "-governance.txt")))
(def sample-anchor-circle (g/create-circle "Courage Labs"))
(def expiration-date (t/date-time 2014 01 01))
(def very-governed-circle
  (-> sample-anchor-circle
      (g/add-role-to-circle "Benefit Context Link"
                            (str "The Organization as a provider of General "
                                 "Public Benefit")
                            nil
                            #{(str "Representing the Benefit Context within"
                                   " the Organization")})
      (g/add-role-to-circle "Investor Context Link"
                            (str "The Organization as an effective investment "
                                 "vehicle for its investors")
                            nil
                            #{(str "Representing the Investor Context within "
                                   "the Organization")})
      (g/add-role-to-circle "Environmental Impact Context Link"
                            (str "The Organization as a good steward of the "
                                 "Environment")
                            nil
                            #{(str "Representing the Environmental Impact "
                                   "Context within the Organization")})
      (g/update-purpose "General public benefit")
      (g/add-role-to-circle "Partner Matters"
                            "Bringing in and making Partners happy")
      (g/appoint-to-role "Partner Matters" "Joe Schmoe" "Contracts")
      (g/add-role-to-circle "Accounting"
                            "Spending money responsibly"
                            ["Checkbook", "Credit Cards"]
                            ["Telling people how much money there is to spend"
                             "Paying people"
                             "Reimbursing for expenses"
                             "Depositing income"])
      (g/appoint-to-role "Accounting" "Jill Schmidt")
      (g/add-role-to-circle "Products"
                            "Building cool products to sell"
                            ["Products"]
                            ["Communicating product direction"
                             "Gathering customer needs"])
      (g/convert-to-circle "Products")
      (g/convert-to-circle "Partner Matters")
      (g/update-role-purpose "Partner Matters"
                             "Ensuring we have the right Partners")
      (g/add-role-domain "Partner Matters" "Addition/Removal of Partners")
      (g/add-role-accountability
        "Partner Matters"
        "Creating policies for addition and removal of partners")
      (g/elect-to-role g/facilitator-name "bill" expiration-date)
      (g/elect-to-role g/secretary-name "jill" expiration-date)
      (g/update-subcircle ["Products"] g/add-role
                          (g/map->Role {:rname "Product Analyzer"}))))
(describe "Parsing governance"
  (it "should ignore comments"
    (should= () (l/parse-governance "--this is fun\n")))

  (it "should allow double quotes in comments"
    (should= () (l/parse-governance "--this is fun \"stuff\"\n"))))
(describe "Executing governance documents"
  (it "should throw nice errors for bad parsing"
    (should-throw GovernanceParseException
      (str "Parse error at line 1, column 32:\nconvert role \"Partner "
           "Matters\" to a circle.\n                               ^\n"
           "Expected:\n\"into a\"\n")
      (l/execute-governance "convert role \"Partner Matters\" to a circle.")))

  (it "should be able to create a new anchor circle without crosslinks"
    (should= (g/create-circle "Courage Labs")
      (l/execute-governance "CREATE ANCHOR CIRCLE \"Courage Labs\".")))

  (it "should be able to create a new anchor with special characters"
    (should= (g/create-circle "Courage & Labs!@#$%^&*()")
      (l/execute-governance
        "CREATE ANCHOR CIRCLE \"Courage & Labs!@#$%^&*()\".")))

  (it "should not allow nonsense in role/circle conversions"
    (should-throw GovernanceParseException
      "Cannot convert circle into a circle."
      (clojure.pprint/pprint
        (l/execute-governance
          (str "create anchor circle \"place\".\n"
               "create role \"Thing\" with purpose \"stuff\".\n"
               "convert role \"Thing\" into a circle.\n"
               "convert circle \"Thing\" into a circle.\n"))))

    (should-throw GovernanceParseException
      "Cannot convert role into a role."
      (clojure.pprint/pprint
        (l/execute-governance
          (str "create anchor circle \"place\".\n"
               "create role \"Thing\" with purpose \"stuff\".\n"
               "convert role \"Thing\" into a role.\n")))))

  (it "should do all the governance"
    (should= very-governed-circle
      (l/execute-directory "spec/freefrog/lang/basic")))

  (describe "governing subcircles"
    (it "won't allow multiple subcircles to be governed in one document"
      (should-throw GovernanceParseException
        #"Parse error at line 3, column 1:\ngovern circle \"Partner Matters\".*"
        (l/execute-governance
          sample-anchor-circle
          (governance "multiple-subcircle"))))
    (it "won't allow subcircle governance except as the first statement"
      (should-throw GovernanceParseException
        #"Parse error at line 2, column 1:\ngovern circle \"stuff\".*"
        (l/execute-governance
          sample-anchor-circle
          "create role \"things\".\ngovern circle \"stuff\".\n"))))

  (describe "Courage Labs Governance smoke test"
    (with-all result (l/execute-directory "spec/freefrog/lang/courage_labs"))
    (it "should be able to execute all Courage Labs Governance"
      (println (yaml/generate-string @result)))))
 
(ns freefrog.render-spec
  (:require [freefrog.governance :as g]
            [freefrog.render :as render]
            [speclj.core :refer :all]
            [clj-time.core :as t]))
(def simple-circle (-> (g/create-circle "simple circle")
                       (g/update-purpose "Simplicity")
                       (g/add-role-to-circle "role 1" "rocking")
                       (g/add-role-accountability "role 1" "doing basic things")
                       (g/add-role-to-circle "role 2" "being #2"
                                             ["dom1" "dom2"]
                                             ["acc1" "acc2"])
                       (g/add-policy "basic policy" "you can do things")
                       (g/add-role-policy "role 2" "basic role policy"
                                          "you also can do things")
                       (g/add-role-to-circle "role 3")
                       (g/add-role-accountability "role 3"
                                                  "other basic things")
                       (g/appoint-to-role "role 2" "larry")
                       (g/appoint-to-role "role 2" "george" "some stuff")
                       (g/elect-to-role g/facilitator-name "phil"
                                        (t/date-time 2014 01 01))
                       (g/elect-to-role g/secretary-name "larry"
                                        (t/date-time 2014 01 01))
                       (g/convert-to-circle "role 3")
                       (g/update-subcircle ["role 3"] g/add-role-to-circle
                                           "test")))
(describe "Simple circle"
  (it "should render the basics of a circle"
    (should= "# simple circle #\nSimplicity\n
Facilitator: phil, expiring 2014-01-01
Secretary: larry, expiring 2014-01-01\n
## Policies ##\n\n  0. basic policy\n
## Roles ##\n\n  0. role 1\n  1. role 2\n  2. role 3\n"
      (render/markdown-role simple-circle))
    (should= "# role 1 #\nrocking\n
## Accountabilities ##\n\n  * doing basic things\n"
      (render/markdown-role (g/get-role simple-circle "role 1")))
    (should=
      "# role 2 #\nbeing #2\n\n## Domains ##\n\n  * dom1\n  * dom2\n
## Accountabilities ##\n\n  * acc1\n  * acc2\n\n## Policies ##\n
  0. basic role policy\n\n## Assignees ##\n
  * larry\n  * george, for some stuff \n"
      (render/markdown-role (g/get-role simple-circle "role 2")))
    (should= "# role 3 #\n\n## Accountabilities ##\n\n  * other basic things\n
## Roles ##\n\n  0. test\n"
      (render/markdown-role (g/get-role simple-circle "role 3")))))