Unique names for SSA

Unique names for SSA

--- POC/aggregation/tools/genAssessments/src/genAssessments/core.clj
+++ POC/aggregation/tools/genAssessments/src/genAssessments/core.clj
@@ -5,414 +5,42 @@
   (:use [clojure.contrib.string :only (substring?)])
 )

-(defn gen-edfi
-  [interchange output-file contents]
-  ; (prn output-file)
-  (with-open [out (java.io.OutputStreamWriter. (java.io.FileOutputStream. output-file) "UTF-8")]
-    (emit (element interchange {:xmlns "http://ed-fi.org/0100"} contents) out)
-  )
-)
-
-(defn gen-student [schoolName studentId]
-  (element :Student {:id (format "%s-%s" schoolName (str studentId))}
-    (element :StudentUniqueStateId {} (format "%s-%s" schoolName (str studentId)))
-    (element :Name {}
-      (element :FirstName {} (rand-nth ["Nathan" "Gina" "Alan" "Morena" "Adam" "Jewel" "Sean" "Summer" "Ron"]))
-      (element :LastSurname {} (rand-nth ["Fillion" "Torres" "Tudyk" "Baccarin" "Baldwin" "Staite" "Maher" "Glau" "Glass"]))
-    )
-    (element :Sex {} (rand-nth ["Male" "Female"]))
-    (element :BirthData {}
-      (element :BirthDate {} (str "2001-" (format "%02d" (inc (rand-int 12))) "-" (format "%02d" (inc (rand-int 28)))))
-    )
-    (element :HispanicLatinoEthnicity {} (rand-nth ["true" "false"]))
-    (element :Race {})
-  )
-)
-
-(defn gen-students [schools rng output-file]
-  (gen-edfi :InterchangeStudentParent output-file
-    (into ()
-      [
-        (for [schoolName schools]
-          (for [id rng
-            :let [tmp (gen-student schoolName id)]
-            ]
-            tmp
-          )
-        )
-      ]
-    )
-  )
-)
-
-(defn create-state []
-  (let [tmp (element :StateEducationAgency {:id "NY"}
-    (element :StateOrganizationId {} "NY")
-    (element :NameOfInstitution {} "New York State Board of Education")
-    (element :OrganizationCategories {}
-      (element :OrganizationCategory {} "State Education Agency")
-    )
-    (element :Address {}
-      (element :StreetNumberName {} "123 Street")
-      (element :City {} "Albany")
-      (element :StateAbbreviation {} "NY")
-      (element :PostalCode {} "11011")
-    )
-  )]
-  tmp
-  )
-)
-
-(defn create-district [districtName]
-  (let [tmp (element :LocalEducationAgency {:id districtName}
-    (element :StateOrganizationId {} districtName)
-    (element :NameOfInstitution {} districtName)
-    (element :OrganizationCategories {}
-      (element :OrganizationCategory {} "Local Education Agency")
-    )
-    (element :Address {}
-      (element :StreetNumberName {} "123 Street")
-      (element :City {}  districtName)
-      (element :StateAbbreviation {} "NY")
-      (element :PostalCode {} "11011")
-    )
-    (element :LEACategory {} "Independent")
-    (element :StateEducationAgencyReference {:ref "NY"})
-    )]
-    tmp
-  )
-)
-
-(defn create-school [districtName, schoolName]
-  (let [tmp (element :School {:id schoolName}
-    (element :StateOrganizationId {} schoolName)
-    (element :EducationOrgIdentificationCode {:IdentificationSystem "School"}
-      (element :ID {} schoolName)
-    )
-    (element :NameOfInstitution {} schoolName)
-    (element :OrganizationCategories {}
-      (element :OrganizationCategory {} "School")
-    )
-    (element :Address {:AddressType "Physical"}
-      (element :StreetNumberName {} "123 Street")
-      (element :City {} "Albany")
-      (element :StateAbbreviation {} "NY")
-      (element :PostalCode {} "11011")
-      (element :NameOfCounty {} districtName)
-    )
-    (element :Telephone {:InstitutionTelephoneNumberType "Main"}
-      (element :TelephoneNumber {} "(425)-555-1212" )
-    )
-    (element :GradesOffered {}
-      (element :GradeLevel {} "First grade")
-      (element :GradeLevel {} "Second grade")
-      (element :GradeLevel {} "Third grade")
-      (element :GradeLevel {} "Fourth grade")
-      (element :GradeLevel {} "Fifth grade")
-      (element :GradeLevel {} "Sixth grade")
-    )
-    (element :SchoolCategories {}
-      (element :SchoolCategory {} "Elementary School")
-    )
-    (element :LocalEducationAgencyReference {:ref districtName})
-  )]
-  tmp
-  )
-)
-
-(defn create-courses [districtName]
-  (let [tmp (element :Course {:id (format "Math007-%s" districtName)}
-    (element :CourseTitle {} "Math007")
-    (element :NumberOfParts {} "1")
-    (element :CourseCode {:IdentificationSystem "CSSC course code"}
-        (element :ID {} (format "Math007-%s" districtName))
-    )
-    (element :CourseDescription {} "7th grade math")
-    (element :EducationOrganizationReference {}
-      (element :EducationalOrgIdentity {}
-        (element :StateOrganizationId {} districtName)
-      )
-    )
-    )]
-    tmp
-  )
-)
-
-(defn gen-schools [districtName schools output-file]
-  (gen-edfi :InterchangeEducationOrganization output-file
-    (reverse
-      (into ()
-        [
-          (create-state)
-          (create-district districtName)
-          (for [schoolName schools
-            :let [tmp (create-school districtName schoolName)]]
-            tmp
-          )
-          (create-courses districtName)
-        ]
-      )
-    )
-  )
-)
-
-(defn create-assessment [assessmentName]
-  (let [tmp (element :Assessment {:id "Grade_7_2011_State_Math"}
-      (element :AssessmentTitle {} assessmentName)
-      (element :AssessmentIdentificationCode {:IdentificationSystem "Test Contractor"}
-        (element :ID {} assessmentName)
-      )
-      (element :AssessmentCategory {} "State summative assessment 3-8 general")
-      (element :AcademicSubject {} "Mathematics")
-      (element :GradeLevelAssessed {} "Seventh grade")
-      (element :AssessmentPerformanceLevel {}
-        (element :PerformanceLevel {}
-          (element :CodeValue {} "W")
-        )
-        (element :AssessmentReportingMethod {} "Scale score")
-        (element :MinimumScore {} "6")
-        (element :MaximumScore {} "14")
-      )
-      (element :AssessmentPerformanceLevel {}
-        (element :PerformanceLevel {}
-          (element :CodeValue {} "B")
-        )
-        (element :AssessmentReportingMethod {} "Scale score")
-        (element :MinimumScore {} "15")
-        (element :MaximumScore {} "20")
-      )
-      (element :AssessmentPerformanceLevel {}
-        (element :PerformanceLevel {}
-          (element :CodeValue {} "S")
-        )
-        (element :AssessmentReportingMethod {} "Scale score")
-        (element :MinimumScore {} "21")
-        (element :MaximumScore {} "27")
-      )
-      (element :AssessmentPerformanceLevel {}
-        (element :PerformanceLevel {}
-          (element :CodeValue {} "E")
-        )
-        (element :AssessmentReportingMethod {} "Scale score")
-        (element :MinimumScore {} "28")
-        (element :MaximumScore {} "33")
-      )
-      (element :ContentStandard {} "State Standard")
-      (element :Version {} "1")
-      (element :RevisionDate {} "2011-03-12")
-      (element :MaxRawScore {} "33")
-    )]
-    tmp
-  )
-)
-
-(defn gen-assessment [assessmentName output-file]
-  (gen-edfi :InterchangeAssessmentMetadata output-file (create-assessment assessmentName))
-)
-
-(defn get-perf-level [score]
-  (cond
-    (> 14 score) "W"
-    (> 20 score) "B"
-    (> 27 score) "S"
-    (> 33 score) "E")
-)
-
-(defn student-ref [schoolName studentId]
-  (element :StudentReference {}
-    (element :StudentIdentity {}
-      (element :StudentUniqueStateId {} (format "%s-%s" schoolName (str studentId)))
-    )
-  )
-)
-
-(defn gen-saa [schoolName studentId assessmentName date]
-  (let [score (rand-nth (range 6 33))]
-    (element :StudentAssessment {:id (format "SAA-%s-%s-%s" schoolName (str studentId) date)}
-      (element :AdministrationDate {} date)
-      (element :AdministrationEndDate {} date)
-      (element :SerialNumber {} "2")
-      (element :ScoreResults {:AssessmentReportingMethod "Scale score"}
-        (element :Result {} (str score))
-      )
-      (element :PerformanceLevels {}
-        (element :CodeValue {} (get-perf-level score))
-      )
-      (student-ref schoolName studentId)
-      (element :AssessmentReference {}
-        (element :AssessmentIdentity {}
-          (element :AssessmentIdentificationCode {:IdentificationSystem "Test Contractor"}
-            (element :ID {} assessmentName)
-          )
-        )
-      )
-    )
-  )
-)
-
-(defn gen-saas
-  [districtName schools students assessment n output-file]
-  (gen-edfi :InterchangeStudentAssessment output-file
-    (for [schoolName schools]
-      (for [studentId students, i (range 1 n)]
-        (gen-saa schoolName studentId assessment (str "2011-10-" (format "%02d" i)))
-      )
-    )
-  )
-)
-
-(defn gen-enroll
-  [schoolName studentId]
-  (element :StudentSchoolAssociation {}
-    (student-ref schoolName studentId)
-    (element :SchoolReference {}
-      (element :EducationalOrgIdentity {}
-        (element :StateOrganizationId {} schoolName)
-      )
-    )
-    (element :EntryDate {} "2011-09-01")
-    (element :EntryGradeLevel {} "Seventh grade")
-  )
-)
-
-(defn gen-section-assoc
-  [schoolName studentId]
-  (element :StudentSectionAssociation {}
-    (student-ref schoolName studentId)
-    (element :SectionReference {}
-      (element :SectionIdentity {}
-        (element :StateOrganizationId {} schoolName)
-        (element :UniqueSectionCode {}  (format "%s-Math-7-2011-Sec2" schoolName))
-      )
-    )
-    (element :BeginDate {} "2011-09-06")
-    (element :EndDate {} "2011-12-16")
-  )
-)
-
-(defn enroll [schoolName studentId]
-  (into () [
-    (gen-enroll schoolName studentId)
-    (gen-section-assoc schoolName studentId) ]
-  )
-)
-
-(defn gen-enrollments [schools rng output-file]
-  (gen-edfi :InterchangeStudentEnrollment output-file
-    (for [schoolName schools]
-      (for [id rng]
-        (enroll schoolName id)
-      )
-    )
-  )
-)
-
-(defn create-session [districtName schoolName]
-  (into () [
-    (element :CalendarDate {:id (format "%s-%s-day" districtName schoolName) }
-      (element :Date {} "2011-09-22")
-      (element :CalendarEvent {} "Instructional day")
-    )
-
-    (element :GradingPeriod {:id (format "%s-%s-GP1" districtName schoolName)}
-      (element :GradingPeriodIdentity {}
-        (element :GradingPeriod {} "End of Year")
-        (element :SchoolYear {} "2011-2012")
-        (element :StateOrganizationId {} districtName)
-      )
-
-      (element :BeginDate {} "2011-09-01")
-      (element :EndDate {} "2011-12-01")
-      (element :TotalInstructionalDays {} "90")
-      (element :CalendarDateReference {:ref (format "%s-%s-day" districtName schoolName)})
-    )
-
-    (element :Session {}
-      (element :SessionName {} (format "%s-%s-Fall-2011" districtName schoolName))
-      (element :SchoolYear {} "2011-2012")
-      (element :Term {} "Fall Semester")
-      (element :BeginDate {} "2011-09-06")
-      (element :EndDate {} "2011-12-16")
-      (element :TotalInstructionalDays {} "75")
-      (element :EducationOrganizationReference {}
-        (element :EducationalOrgIdentity {}
-          (element :StateOrganizationId {} schoolName)
-        )
-      )
-      (element :GradingPeriodReference {:ref (format "%s-%s-GP1" districtName schoolName)})
-      (element :CalendarDateReference {:ref (format "%s-%s-day" districtName schoolName)})
-    ) ]
-  )
-)
-
-(defn gen-sessions [districtName schools output-file]
-  (gen-edfi :InterchangeEducationOrgCalendar output-file
-    (for [schoolName schools]
-      (reverse (create-session districtName schoolName))
-    )
-  )
-)
-
-(defn create-section [districtName schoolName]
-  (into () [
-    (element :CourseOffering {}
-      (element :LocalCourseCode {} (format "%s-%s-Math-7" districtName schoolName))
-      (element :LocalCourseTitle {} "7th Grade Math")
-      (element :SchoolReference {}
-        (element :EducationalOrgIdentity {}
-          (element :StateOrganizationId {} schoolName)
-        )
-      )
-      (element :SessionReference {}
-        (element :SessionIdentity {}
-          (element :SessionName {} (format "%s-%s-Fall-2011" districtName schoolName))
-        )
-      )
-      (element :CourseReference {}
-        (element :CourseIdentity {}
-          (element :CourseCode {:IdentificationSystem "CSSC course code"}
-            (element :ID {} (format "Math007-%s" districtName))
-          )
-        )
-      )
-    )
-
-    (element :Section {}
-      (element :UniqueSectionCode {} (format "%s-%s-Math-7-2011-Sec2" districtName schoolName))
-      (element :SequenceOfCourse {} "1")
-      (element :CourseOfferingReference {}
-        (element :CourseOfferingIdentity {}
-          (element :LocalCourseCode {} (format "%s-%s-Math-7" districtName schoolName))
-          (element :CourseCode {:IdentificationSystem "CSSC course code"}
-            (element :ID {} (format "Math-7-%s" districtName))
-          )
-          (element :Term {} "Fall Semester")
-          (element :SchoolYear {} "2011-2012")
-          (element :StateOrganizationId {} schoolName)
-        )
-      )
-      (element :SchoolReference {}
-        (element :EducationalOrgIdentity {}
-          (element :StateOrganizationId {} schoolName)
-        )
-      )
-      (element :SessionReference {}
-        (element :SessionIdentity {}
-          (element :SessionName {} (format "%s-%s-Fall-2011" districtName schoolName))
-        )
-      )
-    ) ]
-  )
-)
-
-(defn gen-sections [districtName schools output-file]
-  (gen-edfi :InterchangeMasterSchedule output-file
-    (for [schoolName schools]
-      (reverse (create-section districtName schoolName))
-    )
-  )
-)
-
+(def first-names
+  ["James","John","Robert","Michael","William","David","Richard","Charles","Joseph","Thomas","Christopher","Daniel","Paul","Mark",
+   "Donald","George","Kenneth","Steven","Edward","Brian","Ronald","Anthony","Kevin","Jason","Matthew","Gary","Timothy","Jose","Larry",
+   "Jeffrey","Frank","Scott","Eric","Stephen","Andrew","Raymond","Gregory","Joshua","Jerry","Dennis","Walter","Patrick","Peter",
+   "Harold","Douglas","Henry","Carl","Arthur","Ryan","Roger","Joe","Juan","Jack","Albert","Jonathan","Justin","Terry","Gerald","Keith",
+   "Samuel","Willie","Ralph","Lawrence","Nicholas","Roy","Benjamin","Bruce","Brandon","Adam","Harry","Fred","Wayne","Billy","Steve",
+   "Louis","Jeremy","Aaron","Randy","Howard","Eugene","Carlos","Russell","Bobby","Victor","Martin","Ernest","Phillip","Todd","Jesse",
+   "Craig","Alan","Shawn","Clarence","Sean","Philip","Chris","Johnny","Earl","Jimmy","Antonio","Danny","Bryan","Tony","Luis","Mike",
+   "Stanley","Leonard","Nathan","Dale","Manuel","Rodney","Curtis","Norman","Allen","Marvin","Vincent","Glenn","Jeffery","Travis",
+   "Jeff","Chad","Jacob","Lee","Melvin","Alfred","Kyle","Francis","Bradley","Jesus","Herbert","Frederick","Ray","Joel","Edwin","Don",
+   "Eddie","Ricky","Troy","Randall","Barry","Alexander","Bernard","Mario","Leroy","Francisco","Marcus","Micheal","Theodore",
+   "Clifford","Miguel","Oscar","Jay","Jim","Tom","Calvin","Alex","Jon","Ronnie","Bill","Lloyd","Tommy","Leon","Derek","Warren","Darrell",
+   "Jerome","Floyd","Leo","Alvin","Tim","Wesley","Gordon","Dean","Greg","Jorge","Dustin","Pedro","Derrick","Dan","Lewis","Zachary",
+   "Corey","Herman","Maurice","Vernon","Roberto","Clyde","Glen","Hector","Shane","Ricardo","Sam","Rick","Lester","Brent","Ramon",
+   "Charlie","Tyler","Gilbert","Gene","Marc","Reginald","Ruben","Brett","Angel","Nathaniel","Rafael","Leslie","Edgar","Milton","Raul",
+   "Ben","Chester","Cecil","Duane","Franklin","Andre","Elmer","Brad","Gabriel","Ron","Mitchell","Roland","Arnold","Harvey","Jared",
+   "Adrian","Karl","Cory","Claude","Erik","Darryl","Jamie","Neil","Jessie","Christian","Javier","Fernando","Clinton","Ted","Mathew",
+   "Tyrone","Darren","Lonnie","Lance","Cody","Julio","Kelly","Kurt","Allan","Nelson","Guy","Clayton","Hugh","Max","Dwayne","Dwight",
+   "Armando","Felix","Jimmie","Everett","Jordan","Ian","Wallace","Ken","Bob","Jaime","Casey","Alfredo","Alberto","Dave","Ivan",
+   "Johnnie","Sidney","Byron","Julian","Isaac","Morris","Clifton","Willard","Daryl","Ross","Virgil","Andy","Marshall","Salvador",
+   "Perry","Kirk","Sergio","Marion","Tracy","Seth","Kent","Terrance","Rene","Eduardo","Terrence","Enrique","Freddie","Wade"]
+)
+
+(def last-names
+  ["Sears","Mayo","Dunlap","Hayden","Wilder","Mckay","Coffey","Mccarty","Ewing","Cooley","Vaughan","Bonner","Cotton","Holder","Stark",
+   "Ferrell","Cantrell","Fulton","Lynn","Lott","Calderon","Rosa","Pollard","Hooper","Burch","Mullen","Fry","Riddle","Levy","David",
+   "Duke","Odonnell","Guy","Michael","Britt","Frederick","Daugherty","Berger","Dillard","Alston","Jarvis","Frye","Riggs","Chaney",
+   "Odom","Duffy","Fitzpatrick","Valenzuela","Merrill","Mayer","Alford","Mcpherson","Acevedo","Donovan","Barrera","Albert","Cote",
+   "Reilly","Compton","Raymond","Mooney","Mcgowan","Craft","Cleveland","Clemons","Wynn","Nielsen","Baird","Stanton","Snider",
+   "Rosales","Bright","Witt","Stuart","Hays","Holden","Rutledge","Kinney","Clements","Castaneda","Slater","Hahn","Emerson","Conrad",
+   "Burks","Delaney","Pate","Lancaster","Sweet","Justice","Tyson","Sharpe","Whitfield","Talley","Macias","Irwin","Burris","Ratliff",
+   "Mccray","Madden","Kaufman","Beach","Goff","Cash","Bolton","Mcfadden","Levine","Good","Byers","Kirkland","Kidd","Workman","Carney",
+   "Dale","Mcleod","Holcomb","England","Finch","Head","Burt","Hendrix","Sosa","Haney","Franks","Sargent","Nieves","Downs","Rasmussen",
+   "Bird","Hewitt","Lindsay","Le","Foreman","Valencia","Oneil","Delacruz","Vinson","Dejesus","Hyde","Forbes","Gilliam","Guthrie",
+   "Wooten","Huber","Barlow","Boyle","Mcmahon","Buckner","Rocha"]
+)

 (def districts
     ["Abbott","Addison","Adirondack","Afton","Akron","Albany-City","Albion","Alden","Alexander","Alexandria","Alfred",
@@ -459,14 +87,470 @@
      "Ossining","Oswego","Oswego-City","Otego-Unadilla","Otsego-Delaw","Owego-Apalachin",
      "Panama","Parishville","Patchogue","Pavilion","Pawling","Pearl-River","Peekskill","Poland",
      "Randolph","Raquette","Ravena","Red-Creek","Red-Hook","Remsen","Remsenburg",
-     "Salem","Salmon","Sandy-Creek","Saranac","Saranac-Lake","Saratoga-Springs","Saugerties","Sauquoit-Valley" ] )
+     "Salem","Salmon","Sandy-Creek","Saranac","Saranac-Lake","Saratoga-Springs","Saugerties","Sauquoit-Valley" ]
+ )
+
+(defn school-id [i j]
+  (format "PS-%s" (str (+ i j)))
+)
+
+(defn student-id [schoolName studentId]
+  (format "%s-%s" schoolName (str studentId))
+)
+
+(defn course-id [districtName]
+  (format "Math007-%s" districtName)
+)
+
+(defn assessment-id [assessmentName]
+  (str "Grade_7_2011_State_Math")
+)
+
+(defn saa-id [schoolName studentId date]
+  (format "SAA-%s-%s-%s" schoolName (str studentId) date)
+)
+
+(defn section-id [schoolName]
+  (format "%s-Math007-S2" schoolName)
+)
+
+(defn calendar-date-id [schoolName]
+  (format "%s-day" schoolName)
+)
+
+(defn grading-period-id [schoolName]
+  (format "%s-GP1" schoolName)
+)
+
+(defn session-id [schoolName]
+  (format "%s-Fall-2011" schoolName)
+)
+
+(defn local-course-id [schoolName]
+  (format "%s-Math007" schoolName)
+)
+
+(defn student-ref [schoolName studentId]
+  (element :StudentReference {}
+    (element :StudentIdentity {}
+      (element :StudentUniqueStateId {} (student-id schoolName studentId))
+    )
+  )
+)
+
+(defn school-ref [schoolName]
+  (element :SchoolReference {}
+    (element :EducationalOrgIdentity {}
+      (element :StateOrganizationId {} schoolName)
+    )
+  )
+)
+
+(defn ed-org-ref [edOrgName]
+  (element :EducationalOrgIdentity {}
+    (element :StateOrganizationId {} edOrgName)
+  )
+)
+
+(defn section-ref [schoolName]
+  (element :SectionReference {}
+    (element :SectionIdentity {}
+      (element :StateOrganizationId {} schoolName)
+      (element :UniqueSectionCode {}  (section-id schoolName))
+    )
+  )
+)
+
+(defn gen-edfi
+  [interchange output-file contents]
+  ; (prn output-file)
+  (with-open [out (java.io.OutputStreamWriter. (java.io.FileOutputStream. output-file) "UTF-8")]
+    (emit (element interchange {:xmlns "http://ed-fi.org/0100"} contents) out)
+  )
+)
+
+(defn gen-student [schoolName studentId]
+  (element :Student {:id (student-id schoolName studentId)}
+    (element :StudentUniqueStateId {} (student-id schoolName studentId))
+    (element :Name {}
+      (element :FirstName {} (rand-nth first-names))
+      (element :LastSurname {} (rand-nth last-names))
+    )
+    (element :Sex {} (rand-nth ["Male" "Female"]))
+    (element :BirthData {}
+      (element :BirthDate {} (str "2001-" (format "%02d" (inc (rand-int 12))) "-" (format "%02d" (inc (rand-int 28)))))
+    )
+    (element :HispanicLatinoEthnicity {} (rand-nth ["true" "false"]))
+    (element :Race {})
+  )
+)
+
+(defn gen-students [schools rng output-file]
+  (gen-edfi :InterchangeStudentParent output-file
+    (into ()
+      [
+        (for [schoolName schools]
+          (for [id rng
+            :let [tmp (gen-student schoolName id)]
+            ]
+            tmp
+          )
+        )
+      ]
+    )
+  )
+)
+
+(defn create-state []
+  (let [tmp (element :StateEducationAgency {:id "NY"}
+    (element :StateOrganizationId {} "NY")
+    (element :NameOfInstitution {} "New York State Board of Education")
+    (element :OrganizationCategories {}
+      (element :OrganizationCategory {} "State Education Agency")
+    )
+    (element :Address {}
+      (element :StreetNumberName {} "123 Street")
+      (element :City {} "Albany")
+      (element :StateAbbreviation {} "NY")
+      (element :PostalCode {} "11011")
+    )
+  )]
+  tmp
+  )
+)
+
+(defn create-district [districtName]
+  (let [tmp (element :LocalEducationAgency {:id districtName}
+    (element :StateOrganizationId {} districtName)
+    (element :NameOfInstitution {} districtName)
+    (element :OrganizationCategories {}
+      (element :OrganizationCategory {} "Local Education Agency")
+    )
+    (element :Address {}
+      (element :StreetNumberName {} "123 Street")
+      (element :City {}  districtName)
+      (element :StateAbbreviation {} "NY")
+      (element :PostalCode {} "11011")
+    )
+    (element :LEACategory {} "Independent")
+    (element :StateEducationAgencyReference {:ref "NY"})
+    )]
+    tmp
+  )
+)
+
+(defn create-school [districtName, schoolName]
+  (let [tmp (element :School {:id schoolName}
+    (element :StateOrganizationId {} schoolName)
+    (element :EducationOrgIdentificationCode {:IdentificationSystem "School"}
+      (element :ID {} schoolName)
+    )
+    (element :NameOfInstitution {} schoolName)
+    (element :OrganizationCategories {}
+      (element :OrganizationCategory {} "School")
+    )
+    (element :Address {:AddressType "Physical"}
+      (element :StreetNumberName {} "123 Street")
+      (element :City {} "Albany")
+      (element :StateAbbreviation {} "NY")
+      (element :PostalCode {} "11011")
+      (element :NameOfCounty {} districtName)
+    )
+    (element :Telephone {:InstitutionTelephoneNumberType "Main"}
+      (element :TelephoneNumber {} "(425)-555-1212" )
+    )
+    (element :GradesOffered {}
+      (element :GradeLevel {} "First grade")
+      (element :GradeLevel {} "Second grade")
+      (element :GradeLevel {} "Third grade")
+      (element :GradeLevel {} "Fourth grade")
+      (element :GradeLevel {} "Fifth grade")
+      (element :GradeLevel {} "Sixth grade")
+    )
+    (element :SchoolCategories {}
+      (element :SchoolCategory {} "Elementary School")
+    )
+    (element :LocalEducationAgencyReference {:ref districtName})
+  )]
+  tmp
+  )
+)
+
+(defn create-courses [districtName]
+  (let [tmp (element :Course {:id (course-id districtName)}
+    (element :CourseTitle {} "Math 7")
+    (element :NumberOfParts {} "1")
+    (element :CourseCode {:IdentificationSystem "CSSC course code"}
+        (element :ID {} (course-id districtName))
+    )
+    (element :CourseDescription {} "7th grade math")
+    (element :EducationOrganizationReference {} (ed-org-ref districtName))
+    )]
+    tmp
+  )
+)
+
+(defn gen-schools [districtName schools output-file]
+  (gen-edfi :InterchangeEducationOrganization output-file
+    (reverse
+      (into ()
+        [
+          (create-state)
+          (create-district districtName)
+          (for [schoolName schools
+            :let [tmp (create-school districtName schoolName)]]
+            tmp
+          )
+          (create-courses districtName)
+        ]
+      )
+    )
+  )
+)
+
+(defn create-assessment [assessmentName]
+  (let [tmp (element :Assessment {:id (assessment-id assessmentName)}
+      (element :AssessmentTitle {} assessmentName)
+      (element :AssessmentIdentificationCode {:IdentificationSystem "Test Contractor"}
+        (element :ID {} assessmentName)
+      )
+      (element :AssessmentCategory {} "State summative assessment 3-8 general")
+      (element :AcademicSubject {} "Mathematics")
+      (element :GradeLevelAssessed {} "Seventh grade")
+      (element :AssessmentPerformanceLevel {}
+        (element :PerformanceLevel {}
+          (element :CodeValue {} "W")
+        )
+        (element :AssessmentReportingMethod {} "Scale score")
+        (element :MinimumScore {} "6")
+        (element :MaximumScore {} "14")
+      )
+      (element :AssessmentPerformanceLevel {}
+        (element :PerformanceLevel {}
+          (element :CodeValue {} "B")
+        )
+        (element :AssessmentReportingMethod {} "Scale score")
+        (element :MinimumScore {} "15")
+        (element :MaximumScore {} "20")
+      )
+      (element :AssessmentPerformanceLevel {}
+        (element :PerformanceLevel {}
+          (element :CodeValue {} "S")
+        )
+        (element :AssessmentReportingMethod {} "Scale score")
+        (element :MinimumScore {} "21")
+        (element :MaximumScore {} "27")
+      )
+      (element :AssessmentPerformanceLevel {}
+        (element :PerformanceLevel {}
+          (element :CodeValue {} "E")
+        )
+        (element :AssessmentReportingMethod {} "Scale score")
+        (element :MinimumScore {} "28")
+        (element :MaximumScore {} "33")
+      )
+      (element :ContentStandard {} "State Standard")
+      (element :Version {} "1")
+      (element :RevisionDate {} "2011-03-12")
+      (element :MaxRawScore {} "33")
+    )]
+    tmp
+  )
+)
+
+(defn gen-assessment [assessmentName output-file]
+  (gen-edfi :InterchangeAssessmentMetadata output-file (create-assessment assessmentName))
+)
+
+(defn get-perf-level [score]
+  (cond
+    (> 14 score) "W"
+    (> 20 score) "B"
+    (> 27 score) "S"
+    (> 33 score) "E")
+)
+
+(defn gen-saa [schoolName studentId assessmentName date]
+  (let [score (rand-nth (range 6 33))]
+    (element :StudentAssessment {:id (saa-id schoolName studentId date)}
+      (element :AdministrationDate {} date)
+      (element :AdministrationEndDate {} date)
+      (element :SerialNumber {} "2")
+      (element :ScoreResults {:AssessmentReportingMethod "Scale score"}
+        (element :Result {} (str score))
+      )
+      (element :PerformanceLevels {}
+        (element :CodeValue {} (get-perf-level score))
+      )
+      (student-ref schoolName studentId)
+      (element :AssessmentReference {}
+        (element :AssessmentIdentity {}
+          (element :AssessmentIdentificationCode {:IdentificationSystem "Test Contractor"}
+            (element :ID {} assessmentName)
+          )
+        )
+      )
+    )
+  )
+)
+
+(defn gen-saas
+  [districtName schools students assessment n output-file]
+  (gen-edfi :InterchangeStudentAssessment output-file
+    (for [schoolName schools]
+      (for [studentId students, i (range 1 n)]
+        (gen-saa schoolName studentId assessment (str "2011-10-" (format "%02d" i)))
+      )
+    )
+  )
+)
+
+(defn gen-enroll
+  [schoolName studentId]
+  (element :StudentSchoolAssociation {}
+    (student-ref schoolName studentId)
+    (school-ref schoolName)
+    (element :EntryDate {} "2011-09-01")
+    (element :EntryGradeLevel {} "Seventh grade")
+  )
+)
+
+(defn gen-section-assoc
+  [schoolName studentId]
+  (element :StudentSectionAssociation {}
+    (student-ref schoolName studentId)
+    (section-ref schoolName)
+    (element :BeginDate {} "2011-09-06")
+    (element :EndDate {} "2011-12-16")
+  )
+)
+
+(defn enroll [schoolName studentId]
+  (into () [
+    (gen-enroll schoolName studentId)
+    (gen-section-assoc schoolName studentId) ]
+  )
+)
+
+(defn gen-enrollments [schools rng output-file]
+  (gen-edfi :InterchangeStudentEnrollment output-file
+    (for [schoolName schools]
+      (for [id rng]
+        (enroll schoolName id)
+      )
+    )
+  )
+)
+
+
+(defn create-session [districtName schoolName]
+  (into () [
+    (element :CalendarDate {:id (calendar-date-id schoolName) }
+      (element :Date {} "2011-09-22")
+      (element :CalendarEvent {} "Instructional day")
+    )
+
+    (element :GradingPeriod {:id (grading-period-id schoolName)}
+      (element :GradingPeriodIdentity {}
+        (element :GradingPeriod {} "End of Year")
+        (element :SchoolYear {} "2011-2012")
+        (element :StateOrganizationId {} districtName)
+      )
+
+      (element :BeginDate {} "2011-09-01")
+      (element :EndDate {} "2011-12-01")
+      (element :TotalInstructionalDays {} "90")
+      (element :CalendarDateReference {:ref (calendar-date-id schoolName)})
+    )
+
+    (element :Session {}
+      (element :SessionName {} (session-id schoolName))
+      (element :SchoolYear {} "2011-2012")
+      (element :Term {} "Fall Semester")
+      (element :BeginDate {} "2011-09-06")
+      (element :EndDate {} "2011-12-16")
+      (element :TotalInstructionalDays {} "75")
+      (element :EducationOrganizationReference {} (ed-org-ref schoolName))
+      (element :GradingPeriodReference {:ref (grading-period-id schoolName)})
+      (element :CalendarDateReference {:ref (calendar-date-id schoolName)})
+    ) ]
+  )
+)
+
+(defn gen-sessions [districtName schools output-file]
+  (gen-edfi :InterchangeEducationOrgCalendar output-file
+    (for [schoolName schools]
+      (reverse (create-session districtName schoolName))
+    )
+  )
+)
+
+(defn create-section [districtName schoolName]
+  (into () [
+    (element :CourseOffering {}
+      (element :LocalCourseCode {} (local-course-id schoolName))
+      (element :LocalCourseTitle {} "7th Grade Math")
+      (element :SchoolReference {}
+        (element :EducationalOrgIdentity {}
+          (element :StateOrganizationId {} schoolName)
+        )
+      )
+      (element :SessionReference {}
+        (element :SessionIdentity {}
+          (element :SessionName {} (session-id schoolName))
+        )
+      )
+      (element :CourseReference {}
+        (element :CourseIdentity {}
+          (element :CourseCode {:IdentificationSystem "CSSC course code"}
+            (element :ID {} (course-id districtName))
+          )
+        )
+      )
+    )
+
+    (element :Section {}
+      (element :UniqueSectionCode {} (section-id schoolName))
+      (element :SequenceOfCourse {} "1")
+      (element :CourseOfferingReference {}
+        (element :CourseOfferingIdentity {}
+          (element :LocalCourseCode {} (local-course-id schoolName))
+          (element :CourseCode {:IdentificationSystem "CSSC course code"}
+            (element :ID {} (course-id districtName))
+          )
+          (element :Term {} "Fall Semester")
+          (element :SchoolYear {} "2011-2012")
+          (element :StateOrganizationId {} schoolName)
+        )
+      )
+      (element :SchoolReference {}
+        (element :EducationalOrgIdentity {}
+          (element :StateOrganizationId {} schoolName)
+        )
+      )
+      (element :SessionReference {}
+        (element :SessionIdentity {}
+          (element :SessionName {} (session-id schoolName))
+        )
+      )
+    ) ]
+  )
+)
+
+(defn gen-sections [districtName schools output-file]
+  (gen-edfi :InterchangeMasterSchedule output-file
+    (for [schoolName schools]
+      (reverse (create-section districtName schoolName))
+    )
+  )
+)

 (defn gen-district-schools [districtCount schoolsPerDistrict studentsPerSchool]
   ; should distribute this in a more normal distribution
   (for [i (range 1 (+ districtCount 1))
     :let [r (assoc (hash-map) (districts i)
       (for [j (range 1 (+ 1 schoolsPerDistrict))]
-        (format "PS-%s" (str (+ i j)))))]]
+        (school-id i j)))]]
    r)
 )

@@ -537,7 +621,7 @@

 (defn gen-big-data
   [districtCount schoolCount studentCount]
-  (def sectionName "7th Grade Math - Sec 2")
+  (def sectionName "Math007-S2")
   (def assessmentName "Grade 7 State Math")
   (def i (make-counter 0))
   ;(def i (atom 0))


use external client-id etc.

use external client-id etc.

--- src/oauthtest/core.clj
+++ src/oauthtest/core.clj
@@ -10,8 +10,8 @@
                   ;;; (contrary to this example, you probably want to keep client-secret private, so
                   ;;; you'll probably want to get it from some config instead of hardcoding it in
                   ;;; your source code):
-                  :client-id     "817304564499-tg8htvvunf7ds8rbp0jc30ijm20odo7k.apps.googleusercontent.com"
-                  :client-secret "dFlqsKkhk0oA1se3zk5AUKYJ"
+                  :client-id     google-client-id
+                  :client-secret google-client-secret

                   ;;; redirect-url: Point this to the url you want users to be redirected to after they've
                   ;;;   completed authentication at the OP (note that you might have to tell your OP a list
@@ -30,8 +30,8 @@
                   :jwks-url      "https://www.googleapis.com/oauth2/v3/certs"
                   })

-(def github-data {:client-id     "65eacce92b11d7422fed"
-                  :client-secret "831a93010452b94404f0c700d471c9dd29ba0260"
+(def github-data {:client-id     github-client-id
+                  :client-secret github-client-secret
                   :redirect-url  "http://localhost:8899/auth/code"
                   :scopes        ["openid" "user:email"]
                   :issuer        ""
@@ -46,13 +46,6 @@
 ;;; FIXME: evil stuff, just for demonstration though:
 (defonce laststate (atom nil))
 (defonce lastnonce (atom nil))
-
-
-(comment (defn get-env []
-           {:clientid (System/getenv "CLIENTID")
-            :clientsecret (System/getenv "CLIENTSECRET")
-            :provideruri (System/getenv "PROVIDERURI")
-            :redirecturi (System/getenv "REDIRECTURI")}))

 (defroutes auth-routes


Unified play-melody and play-progression.

--- src/overtunes/core.clj
+++ src/overtunes/core.clj
@@ -1,6 +1,6 @@
 (ns overtunes.core
   (:use
-    [overtone.live :exclude [scale octave sharp flat sixth unison]]
+    [overtone.live :exclude [scale octave sharp flat sixth unison play]]
     [overtone.inst.sampled-piano :only [sampled-piano]]))

 (defn beat-length
@@ -36,23 +36,22 @@

 ; Let's play!
 (def note# sampled-piano)
-(defn chord# [chord] (let [notes (vals chord)]
-                       (doseq [note notes] (note# note))))
+(defn chord# [chord] (doseq [note chord] (note# note)))
+
+(defn play-phrase
+  "Plays a phrase using f according to metro's timing."
+  [phrase f metro]
+  (when-not (empty? (first phrase))
+    (let [[[sound & sounds] [timing & timings]] phrase]
+      (at (metro) (f sound))
+      (play-phrase [sounds timings] f (metronome-from metro timing)))))

 (defn play-progression
   "Plays a chord progression on instrument according to metro's timing."
   [progression instrument metro]
-  (when-not (empty? (first progression))
-    (let [[[chord & chords] [timing & timings]] progression]
-      (at (metro) (chord# chord))
-      (play-progression [chords timings] instrument (metronome-from metro timing)))))
+  (play-phrase progression #(chord# (vals %)) metro))

 (defn play-melody
-  "Plays a seq of weighted notes on instrument.
-  Takes a relative metronome in addition to the melody.
-  (play-melody [[:C3 :E3 :G3][1/1 1/2 3/2]] organ-cornet metro)"
+  "Plays a melody on instrument according to metro's timing."
   [melody instrument metro]
-  (when-not (empty? (first melody))
-    (let [[[note & notes] [timing & timings]] melody]
-      (at (metro) (note# note))
-      (play-melody [notes timings] instrument (metronome-from metro timing)))))
+  (play-phrase melody #(note# %) metro))


fix reloading of views

fix reloading of views

--- src/status_im/ui/screens/views.cljs
+++ src/status_im/ui/screens/views.cljs
@@ -315,10 +315,11 @@

 (defonce rand-label (rand/id))

-(defonce main-component (atom nil))
+(defonce initial-view-id (atom nil))

 (defn main []
-  (let [view-id        (re-frame/subscribe [:get :view-id])]
+  (let [view-id        (re-frame/subscribe [:get :view-id])
+        main-component (atom nil)]
     (reagent/create-class
      {:component-did-mount
       (fn []
@@ -326,14 +327,30 @@
         (utils.universal-links/initialize))
       :component-will-mount
       (fn []
-        (when (and @view-id (not @main-component))
-          (reset! main-component (get-main-component2 @view-id))))
+        (when-not @initial-view-id
+          (reset! initial-view-id @view-id))
+        (when (and @initial-view-id
+                   (or
+                    js/goog.DEBUG
+                    (not @main-component)))
+          (reset! main-component (get-main-component2
+                                  (if js/goog.DEBUG
+                                    @initial-view-id
+                                    @view-id)))))
       :component-will-unmount
       utils.universal-links/finalize
       :component-will-update
       (fn []
-        (when (and @view-id (not @main-component))
-          (reset! main-component (get-main-component2 @view-id)))
+        (when-not @initial-view-id
+          (reset! initial-view-id @view-id))
+        (when (and @initial-view-id
+                   (or
+                    js/goog.DEBUG
+                    (not @main-component)))
+          (reset! main-component (get-main-component2
+                                  (if js/goog.DEBUG
+                                    @initial-view-id
+                                    @view-id))))
         (react/dismiss-keyboard!))
       :component-did-update
       (fn []


⚡ Find :view-territory permits lazily

⚡ Find :view-territory permits lazily

Why:
- In the common case the user already has a :view-congregation permit,
  so the territory IDs are never used. They however need to be lexically
  outside the cond form, to avoid calculating it twice for both the
  cond's test and expr.

--- src/territory_bro/domain/facade.clj
+++ src/territory_bro/domain/facade.clj
@@ -31,8 +31,8 @@
 ;; TODO: deduplicate with congregation/apply-user-permissions
 (defn- apply-user-permissions [cong state user-id]
   (let [cong-id (:id cong)
-        territory-ids (for [[_ _ territory-id] (permissions/match state user-id [:view-territory cong-id '*])]
-                        territory-id)]
+        territory-ids (lazy-seq (for [[_ _ territory-id] (permissions/match state user-id [:view-territory cong-id '*])]
+                                  territory-id))]
     (cond
       (permissions/allowed? state user-id [:view-congregation cong-id])
       cong


adding conditional flags to zlib for linux / os x builds

--- config/software/zlib.clj
+++ config/software/zlib.clj
@@ -17,15 +17,23 @@
 ;; limitations under the License.
 ;;

+(let [env (cond
+           (and (is-os? "darwin") (is-machine? "x86_64"))
+           {
+            "LDFLAGS" "-R/opt/opscode/embedded/lib -L/opt/opscode/embedded/lib -I/opt/opscode/embedded/include"
+            "CFLAGS" "-I/opt/opscode/embedded/include -L/opt/opscode/embedded/lib"
+            }
+           (is-os? "linux")
+           {
+            "LDFLAGS" "-Wl,-rpath /opt/opscode/embedded/lib -L/opt/opscode/embedded/lib -I/opt/opscode/embedded/include"
+            "CFLAGS" "-I/opt/opscode/embedded/include -L/opt/opscode/embedded/lib"
+            }
 (software "zlib"
           :source "zlib-1.2.5"
           :steps [
                   {
                    :command "./configure"
-                   :env {
-                         "LDFLAGS" "-R/opt/opscode/embedded/lib -L/opt/opscode/embedded/lib -I/opt/opscode/embedded/include"
-                         "CFLAGS" "-I/opt/opscode/embedded/include -L/opt/opscode/embedded/lib"
-                         }
+                   :env
                    :args ["--prefix=/opt/opscode/embedded"]
                    }
                   { :command "make" }


Cosmetics for context-editor

Cosmetics for context-editor

Signed-off-by: Daniel Borchmann <25857343a15bf1edafebc2912e82ecf775c585c1@mailbox.tu-dresden.de>

--- src/conexp/contrib/gui/editors/context_editor/context_editor.clj
+++ src/conexp/contrib/gui/editors/context_editor/context_editor.clj
@@ -147,26 +147,19 @@
           e-ctx   @ectx,
           widget  (context-editor-widget. (get-widget root) table toolbar ectx),
           keystroke-fill  (KeyStroke/getKeyStroke KeyEvent/VK_SPACE
-                                                ActionEvent/CTRL_MASK false),
-          add-button- (fn [toolbar text f & args]
-                        (add-button toolbar
-                                    (doto (make-tooltip-button "no-tip" text)
-                                      (set-handler #(set-context @ectx (f widget))))))
-
-          add-separator (fn [toolbar]
-                          (add-button toolbar (Box/createVerticalStrut 3)))
-
+                                                  ActionEvent/CTRL_MASK false),
+
           add-button-box (fn [toolbar & buttonlist]
                            (let [box (Box/createHorizontalBox)]
                              (doseq [button buttonlist]
                                (if (contains? button :spacer)
                                  (.add box (Box/createHorizontalStrut (:spacer button)))
-                                 (let [ bctrl (make-tooltip-button (:tip button) (:name button))
-                                        handler #(do
-                                                   (if (contains? button :no-return)
-                                                     ((:no-return button) widget))
-                                                   (if (contains? button :f)
-                                                     (set-context @ectx ((:f button) widget))))]
+                                 (let [bctrl (make-tooltip-button (:tip button) (:name button))
+                                       handler #(do
+                                                  (if (contains? button :no-return)
+                                                    ((:no-return button) widget))
+                                                  (if (contains? button :f)
+                                                    (set-context @ectx ((:f button) widget))))]
                                    (set-handler bctrl handler)
                                    ;;(add-button toolbar bctrl)))
                                    (.add box ^JComponent (get-widget bctrl)))))
@@ -176,18 +169,18 @@
       (doto toolbar
         (set-floatable false)
         (add-button-box  { :name (get-image-icon-or-string "context-editor/copy.png" "C"),
-                           :tip  "Copy the selected cells to clipboard",
-                           :no-return #(copy-to-clipboard (get-table %)) }
+                          :tip  "Copy the selected cells to clipboard",
+                          :no-return #(copy-to-clipboard (get-table %)) }
                          { :name (get-image-icon-or-string "context-editor/cut.png" "X"),
-                           :tip  "Cut the selected cells to clipboard",
-                           :no-return #(cut-to-clipboard (get-table %)) }
+                          :tip  "Cut the selected cells to clipboard",
+                          :no-return #(cut-to-clipboard (get-table %)) }
                          { :name (get-image-icon-or-string "context-editor/paste.png" "P"),
-                           :tip  "Paste the clipboard to the selected cell and its down-right neighbors",
-                           :no-return #(paste-from-clipboard (get-table %)) }
+                          :tip  "Paste the clipboard to the selected cell and its down-right neighbors",
+                          :no-return #(paste-from-clipboard (get-table %)) }
                          { :name (get-image-icon-or-string "context-editor/second-op.png" "M+"),
-                           :tip  "Use a copy of this context as second operand",
-                           :no-return #(reset! second-operand (get-context (get-ectx %))) }
-                        )
+                          :tip  "Use a copy of this context as second operand",
+                          :no-return #(reset! second-operand (get-context (get-ectx %))) }
+                         )
         (add-button-box {:name (get-image-icon-or-string "context-editor/add-attribute.png" "+A"),
                          :tip "Adds a new attribute column to the context",
                          :f add-new-attribute}
@@ -215,7 +208,7 @@
                          :tip "Remove all selected rows and columns from the context",
                          :f cut-objects-attributes})
         (add-button-box {:name (get-image-icon-or-string "context-editor/clarify-attribute.png"
-                                "cA"),
+                                                         "cA"),
                          :tip "Clarify the attribute columns of the context",
                          :f (cc-1 clarify-attributes)}
                         {:name (get-image-icon-or-string "context-editor/clarify-object.png" "cO"),
@@ -226,7 +219,7 @@
                          :f (cc-1 clarify-context)}
                         {:spacer 3}
                         {:name (get-image-icon-or-string "context-editor/reduce-attribute.png"
-                                "rA"),
+                                                         "rA"),
                          :tip "Reduce the attribute columns of the context",
                          :f (cc-1 reduce-attributes)}
                         {:name (get-image-icon-or-string "context-editor/reduce-object.png" "rO"),
@@ -236,7 +229,7 @@
                          :tip "Reduce both objects and attributes of the context",
                          :f (cc-1 reduce-context)})
         (add-button-box {:name (get-image-icon-or-string "context-editor/transitive-closure.png"
-                               "trans"),
+                                                         "trans"),
                          :tip "Apply transitive closure to the context",
                          :f (cc-1 context-transitive-closure)}
                         {:spacer 3}


remove comp pre-checks, just as head pre-checks are removed

--- src/babel/over.cljc
+++ src/babel/over.cljc
@@ -40,17 +40,6 @@
     (if (= result true)
       (log/debug (str "check-vals caught a fail: p1=" p1 "; p2=" p2 "; fail-path:" (fail-path m1 m2))))
     result))
-
-(defn comp-pre-checks [parent child]
-  (or
-   (check-vals parent child [:comp :synsem :cat]            [:synsem :cat])
-   (check-vals parent child [:comp :synsem :agr]            [:synsem :agr])
-   (check-vals parent child [:comp :synsem :case]           [:synsem :case])
-   (check-vals parent child [:comp :synsem :sem]            [:synsem :sem])
-   (check-vals parent child [:comp :synsem :reflexive]      [:synsem :reflexive])
-   (check-vals parent child [:comp :synsem :pronoun]        [:synsem :pronoun])
-   (check-vals parent child [:comp :synsem :subcat]         [:synsem :subcat])
-   ))

 (defn moreover-head [parent child & [morph]]
   (let [morph (if morph morph (fn [x] (str "(no morph function provided:" x)))]
@@ -113,7 +102,7 @@
       (log/trace (str "overh: parent: " parent))
       (log/trace (str "overh: head: " head))))
   ;; TODO: get rid of all this type-checking and use
-  ;; whatever the smart people use for Clojure argument type-checking.
+  ;; whatever people use for Clojure argument type-checking.
   (cond

    (nil? head)
@@ -203,11 +192,9 @@
                        (overc parent child))
                      comp-children)))
    true
-   (let [check-result (comp-pre-checks parent comp)
-         result (if check-result :fail
-                      (unifyc parent
-                              {:comp comp}))
-         is-fail? (fail? result)]
+   (let [result (unifyc parent
+                        {:comp comp})
+         is-fail? (= :fail result)]
      (if (not is-fail?)
        (do
          (log/debug (str "overc: " (get-in parent [:rule]) " -> " (get-in comp [:rule]


Add CORS headers

Add CORS headers


IO needs to be done through an agent since it could be called from inside a transaction

--- src/subrosa/client.clj
+++ src/subrosa/client.clj
@@ -32,7 +32,8 @@

 (defn send-to-client* [channel msg]
   (when (.isWritable channel)
-    (.write channel (str msg "\n"))))
+    (send (agent nil)
+          (fn [_] (io! (.write channel (str msg "\n")))))))

 (defn send-to-client
   ([channel code msg]


Delete spans.clj

Delete spans.clj

--- spans.clj
+++ spans.clj
@@ -1,119 +0,0 @@
-;
-; spans.clj
-; An exploration of spans of time in a calendar and relating them to
-; a model period or epoch where values are specified. Use the model
-; epoch as a source for data to populate other epochs through
-; a map of events to allow for changing event dates and durations.
-;
-;
-; notes
-; - julian numbers, not dates
-; - variable epoch length, "week" length
-' - fencepost spans indeces
-;
-; work log
-; 4-15 45 minutes in front of TV
-; 4-16 20 minutes en route to Louisville
-;
-
-(def epoch-length 100)
-(def week-length 7)
-(def months (list 31 28 31 30 31 30 31 31 30 31 30 31))
-
-(defn week-of
-"given a month and week, returns a span in day-of-year from the start  to the end of that week"
-[week month]
-	(println "week-of" month week)
-	(def months-part (+ (reduce + 0 (take month months) )))
-	(list
-	 	(+ months-part (* (- week 1) week-length))
-	 	(+ months-part (* week week-length))))
-
-(defn day-of-year
-"takes a traditional, 1-based, date and returns day of year - leap year notwithstanding"
-[month day]
-	(+ (reduce + (take (- month 1) months))
-		day))
-
-(defn julian
-"lame attempt at calculating julian day for demo purposes"
-[year month day]
-1)
-
-; name --> (start-julian, end-julian, year)
-(def events {
-	:new-years  (list (day-of-year 12 31) (day-of-year 1 2) 2012)
-	:mlk 		(list (day-of-year 1 13) (day-of-year 1 14) 2012)
-	:presidents (list (day-of-year 2 14) (day-of-year 2 15) 2012)
-	:spring-break (week-of 3 3)
-	:new-years  (list (day-of-year 12 31) (day-of-year 1 2) 2013)
-	:mlk 		(list (day-of-year 1 13) (day-of-year 1 14) 2013)
-	:presidents (list (day-of-year 2 14) (day-of-year 2 15) 2013)
-	:spring-break (week-of 3 3)
-	:new-years  (list (day-of-year 12 31) (day-of-year 1 2) 2014)
-	:mlk 		(list (day-of-year 1 13) (day-of-year 1 14) 2014)
-	:presidents (list (day-of-year 2 14) (day-of-year 2 15) 2014)
-	:spring-break (week-of 3 3)
-})
-
-; to create a multi-epoch list of daily values,
-; you need a way to collect events with the same name across epochs
-; and access them by an intra-epoch offset
-
-
-; julian --> (epoch-number, epoch-offset)
-(defn julian-to-epoch-pair
-"given a julian day number for a base-epoch start and an event day, returns an ep ch number and offset"
-[event-julian epoch-length  epoch-start-julian]
-	(assert (> event-julian epoch-start-julian) ; assert? TODO
-	(list (% (- event-julian epoch-start-julian) epoch-length)
-			(/ (- event-julian epoch-start-julian) epoch-length )))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; money ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defn mapping-span
-"creates a set of spans in the original epoch for an event instance in a future epoch"
-[orig-epoch  epoch-length event-epoch event-offset ]
-)
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
- --> (name, (epoch-number, epoch-offset))
-(defn make-event-map
-"maps events between epochs of the given length in preparation for epoch generation.
-the events may have different offsets for each epoch"
-[epoch-start epoch-length events]
-	(let [event-names (reduce assoc #{} (keys events)) ; keys? TODO
-			]
-		(map (fn [event-name]
-			; get the set of epoch/offset pairs for each holiday with this name and associate
-			; for each event after the original epoch calculate the spans back onto the original epoch
-				)
-			event-nams)
-
-;;;;;;; epoch ;;;;;;;;;;;;;;;
-
-(defn  make-epoch
-" creates a hash of date-to-date for the given length and start
-[start length val]
-	(loop [event-hash {} count 0]
-		(cond (< count length)
-			(recur (assoc event-hash (+ count + start) val ) (+ count 1))
-			:t event-hash)))
-
-(defn add-to-epoch
-"modifies (in the immutable sense) an existing events map by inserting values for the given event"
-[evens span value]
-	(loop [start (first span) loop-events events ]
-		(cond (= start (second span)) loop-events
-			:t (recur  (+ start 1) (assoc loop-events start value)))))
-
-(defn generate-epochs
-"takes a events map populated with a first epoch and "
-[])
-
-(def epoch (sort (add-to-epoch (make-epoch 100) (week-of 2 1)  10)))
-(println epoch)
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-
-


Add :present option.

Add :present option.

--- src/quil/applet.clj
+++ src/quil/applet.clj
@@ -162,7 +162,7 @@

 (defn -exit [this] (.dispose this))

-(defn -sketchFullScreen [this] false)
+(defn -sketchFullScreen [this] (:present (meta this)))

 (defn -quil-applet-init [state]
   [[] state])
@@ -242,7 +242,7 @@

 (def ^{:private true}
   opts-applet-params
-  #{:resizable :exit-on-close :keep-on-top})
+  #{:resizable :exit-on-close :keep-on-top :present})

 (defn applet
   "Create and start a new visualisation applet.


Use a sorted-map for SQS message

Use a sorted-map for SQS message


Fix rendering of empty state

Fix rendering of empty state

--- src/app/core.cljs
+++ src/app/core.cljs
@@ -263,7 +263,7 @@
                                             (:guests party))))
         (cond (true? sent) (om/build rsvp-confirmation-view response)
               (some? party) (om/build rsvp-card-view party)
-              (some? results) (om/build rsvp-multiple-results-view data)
+              (seq results) (om/build rsvp-multiple-results-view data)
               :else (html [:div "Zero"]))))))

 (defn rsvp-view [{:keys [results] :as data} owner]


Use `case` where applicable

Use `case` where applicable

--- src/cljam/bam.clj
+++ src/cljam/bam.clj
@@ -27,7 +27,7 @@
         (fn [op]
           (let [[tag value] (first (seq op))]
             (+ fixed-tag-size
-               (condp = (first (:type value))
+               (case (first (:type value))
                  \A 1
                  \i 4
                  \f 4
@@ -35,7 +35,7 @@
                  \B (let [[array-type & array] (split (:value value) #",")]
                       (+ fixed-binary-array-tag-size
                          (* (count array)
-                            (condp = (first array-type)
+                            (case (first array-type)
                               \c 1
                               \C 1
                               \s 2
@@ -275,14 +275,14 @@
     (catch EOFException e nil)))

 (defn- write-tag-value [writer val-type value]
-  (condp = val-type
+  (case val-type
     \A (lsb/write-bytes  writer (char value))
     \i (lsb/write-int    writer (Integer/parseInt value))
     \f (lsb/write-float  writer (Float/parseFloat value))
     \Z (lsb/write-string writer value)
     ;; \H nil
     \B (let [[array-type & array] (split value #",")]
-         (condp = (first array-type)
+         (case (first array-type)
            \c nil
            \C nil
            \s nil


Add tests for insert-if-new and isins entity

--- test/boefie_invest/db/core_test.clj
+++ test/boefie_invest/db/core_test.clj
@@ -219,14 +219,37 @@
 (deftest query-date-snapshots-2-0-1 (mytest [2 0 1]))
 (deftest query-date-snapshots-2-1-0 (mytest [2 1 0]))

-
-(deftest test-insert-if-new
+(deftest test-insert-if-new-for-isins
+  (doseq [test-conn connections]
+    (let [isins (korma.core/database dbc/isins test-conn)
+          a-row {:isin "ab1234567890"}
+          another-row {:isin "de1234567890"}]
+
+      (testing "default date_added is now"
+        (dbc/insert-if-new isins [a-row])
+        (let [results (dbc/select-all isins)]
+          (is (= [a-row] results))))
+
+      (testing "adding an existing row has no effect"
+        (dbc/insert-if-new isins [a-row])
+        (let [results (dbc/select-all isins)]
+          (is (= [a-row] results))))
+
+      (testing "existing rows are ignored, but the rest of them are inserted"
+        (dbc/insert-if-new isins [a-row
+                                  another-row
+                                  a-row])
+        (let [results (dbc/select-all isins)]
+          (is (= a-row (first results)))
+          (is (= another-row (second results)))
+          (is (= 2 (count results))))))))
+
+(deftest test-insert-if-new-for-securities
   (doseq [test-conn connections]
     (let [isins (korma.core/database dbc/isins test-conn)
           securities (korma.core/database dbc/securities test-conn)
           ;; we move before-inserts 1 second into the past to allow
           ;; for databases with 1 second granularity in the time stamps
-
           before-inserts (clj-time.core/minus (now) (clj-time.core/seconds 1))
           a-row {:isin "ab1234567890" :name "foobar"}
           row-with-date {:isin "de1234567890" :name "barbaz"
@@ -242,7 +265,7 @@
         (let [first-result (first (dbc/select-all securities))]
           (is (contains? first-result :date_added))
           (is (before? before-inserts (:date_added a-row)))
-          (is (= [a-row] [(dissoc first-result :date_added)]))))
+          (is (= a-row (dissoc first-result :date_added)))))

       (testing "date_added can be set explicitly"
         (dbc/insert-if-new securities [row-with-date])
@@ -250,8 +273,8 @@
               first-result (first results)]
           (is (contains? first-result :date_added))
           (is (before? before-inserts (:date_added a-row)))
-          (is (= [a-row] [(dissoc first-result :date_added)]))
-          (is (= [row-with-date] [(second results)]))
+          (is (= a-row (dissoc first-result :date_added)))
+          (is (= row-with-date (second results)))
           (is (= 2 (count results)))))

       (testing "adding an existing row has no effect"
@@ -260,21 +283,18 @@
               first-result (first results)]
           (is (contains? first-result :date_added))
           (is (before? before-inserts (:date_added a-row)))
-          (is (= [a-row] [(dissoc first-result :date_added)]))
-          (is (= [row-with-date] [(second results)]))
+          (is (= a-row (dissoc first-result :date_added)))
+          (is (= row-with-date (second results)))
           (is (= 2 (count results)))))

       (testing "existing rows are ignored, but the rest of them are inserted"
-        (dbc/insert-if-new securities [row-with-date
-                                       a-row
-                                       another-row
-                                       a-row])
+        (dbc/insert-if-new securities [row-with-date a-row another-row a-row])
         (let [results (dbc/select-all securities)
               first-result (first results)
               third-result (nth results 2)]
           (is (contains? first-result :date_added))
           (is (before? before-inserts (:date_added a-row)))
-          (is (= [a-row] [(dissoc first-result :date_added)]))
-          (is (= [row-with-date] [(second results)]))
-          (is (= [another-row] [(dissoc third-result :date_added)]))
+          (is (= a-row (dissoc first-result :date_added)))
+          (is (= row-with-date (second results)))
+          (is (= another-row (dissoc third-result :date_added)))
           (is (= 3 (count results))))))))


Add support for node tenuring taint (#1813)

Co-authored-by: Scott Crosby <23e8f75489aff47cf2cd5a529e9a769a24e9501c@twosigma.com>

--- scheduler/src/cook/kubernetes/api.clj
+++ scheduler/src/cook/kubernetes/api.clj
@@ -46,6 +46,13 @@
 ; This pod annotation signals to the cluster autoscaler that
 ; it's safe to remove the node on which the pod is running
 (def k8s-safe-to-evict-annotation "cluster-autoscaler.kubernetes.io/safe-to-evict")
+; We want nodes older than 5 minutes to get this taint. A separate process taints those old nodes
+; with this taint. Cook ignores it for scheduling purposes, but synthetic pods are configured so they
+; don't ignore it. Cook creates synthetic pods as a scaling signal. When they run on existing nodes,
+; the signal we intend to send to the autoscaler is attenuated and we autoscale much less than intended.
+;
+; We prefix the taint with the ignore-taint string so that the autoscaler won't use this when constructing exemplar new nodes.
+(def tenured-node-taint "ignore-taint.cluster-autoscaler.kubernetes.io/cook-node-tenured")

 (def default-shell
   "Default shell command used by our k8s scheduler to wrap and launch a job command
@@ -433,7 +440,7 @@
     false
     (let [taints-on-node (or (some-> node .getSpec .getTaints) [])
           other-taints (remove #(contains?
-                                  #{cook-pool-taint-name k8s-deletion-candidate-taint gpu-node-taint}
+                                  #{cook-pool-taint-name k8s-deletion-candidate-taint gpu-node-taint tenured-node-taint}
                                   (.getKey %))
                                taints-on-node)
           node-name (some-> node .getMetadata .getName)
@@ -603,6 +610,12 @@
     (.setOperator toleration "Equal")
     (.setEffect toleration "NoSchedule")
     toleration))
+
+(def toleration-tenured-node
+  (doto (V1Toleration.)
+    (.setKey tenured-node-taint)
+    (.setOperator "Exists")
+    (.setEffect "NoSchedule")))

 (def toleration-for-deletion-candidate-of-autoscaler
   (doto (V1Toleration.)
@@ -1043,7 +1056,10 @@
       ; (https://kubernetes.io/docs/concepts/configuration/pod-priority-preemption/)
       ; from happening. We want this pod to preempt lower priority pods
       ; (e.g. synthetic pods).
-      (add-node-selector pod-spec k8s-hostname-label hostname)
+      (do
+        (add-node-selector pod-spec k8s-hostname-label hostname)
+        ; Allow real pods to run on tenured nodes.
+        (.addTolerationsItem pod-spec toleration-tenured-node))
       (when (seq pod-hostnames-to-avoid)
         ; Use node "anti"-affinity to disallow scheduling on nodes with particular labels
         ; (https://kubernetes.io/docs/concepts/configuration/assign-pod-node/#node-affinity)


Switch classloader for duration of test to make it work

--- test/powderkeg/integration_test.clj
+++ test/powderkeg/integration_test.clj
@@ -68,7 +68,13 @@
   (f)
   (keg/disconnect!))

-(use-fixtures :once with-cluster with-connection)
+(defn with-cl [f]
+  (let [cl (.getContextClassLoader (Thread/currentThread))]
+    (.setContextClassLoader (Thread/currentThread) (clojure.lang.DynamicClassLoader. cl))
+    (f)
+    (.setContextClassLoader (Thread/currentThread) cl)))
+
+(use-fixtures :once with-cluster with-cl with-connection)

 (deftest rdd
   (is (= (into [] (keg/rdd (range 10)))


rephrase landing page text

rephrase landing page text

--- priv/ui/src/holiday_ping_ui/common/views.cljs
+++ priv/ui/src/holiday_ping_ui/common/views.cljs
@@ -66,8 +66,8 @@
   [section
    [:div.has-text-centered
     [:br]
-    [:h1.title.is-1.has-text-primary.landing-title "Don't forget your time off ever again"]
-    [:h3.subtitle.is-4 "Let HolidayPing send your reminders and enjoy your daiquiri"]
+    [:h1.title.is-1.has-text-primary.landing-title "Don't ever forget to report your time off again"]
+    [:h3.subtitle.is-4 "HolidayPing notifies your clients, you enjoy a daiquiri"]
     [:br]
     [:br]
     [:a.button.is-success.is-large


Fix more typos.

Fix more typos.

--- src/oc/storage/resources/entry.clj
+++ src/oc/storage/resources/entry.clj
@@ -456,14 +456,14 @@
   ([conn entry-uuid :- lib-schema/UniqueID user :- lib-schema/User]
    {:pre [(db-common/conn? conn)]}
    (when-let [updated-entry (db-common/add-to-set table-name entry-uuid :bookmarks (:user-id user))]
-    (update-entry-no-user! conn (:uuid original-entry) updated-entry))))
+    (update-entry-no-user! conn entry-uuid updated-entry))))

 (schema/defn ^:always-validate remove-bookmark! :- (schema/maybe common/Entry)
   "Remove a bookmark for the give entry uuid and user"
   ([conn entry-uuid :- lib-schema/UniqueID user :- lib-schema/User]
    {:pre [(db-common/conn? conn)]}
    (when-let [updated-entry (db-common/remove-from-set table-name entry-uuid :bookmarks (:user-id user))]
-    (update-entry-no-user! conn (:uuid original-entry) updated-entry))))
+    (update-entry-no-user! conn entry-uuid updated-entry))))

 ;; ----- Data about entries -----


style error message

style error message

--- src/otto/html.clj
+++ src/otto/html.clj
@@ -26,7 +26,7 @@
 (defn- repository-collection
   [repositories]
   (if (empty? repositories)
-    [:p "Listing currently unavailable."]
+    [:div.alert.alert-danger "Listing currently unavailable."]
     [:table.table.table-condensed
      [:thead
       [:tr


changing stack trace printing to support windows better

--- sidecar/src/figwheel_sidecar/auto_builder.clj
+++ sidecar/src/figwheel_sidecar/auto_builder.clj
@@ -2,12 +2,11 @@
   (:require
    [clojure.pprint :as p]
    [figwheel-sidecar.core :as fig]
-   #_[figwheel-sidecar.repl :as fig-repl]
    [figwheel-sidecar.config :as config]
    [cljs.repl]
    [cljs.analyzer :as ana]
    [cljs.env]
-   [clj-stacktrace.repl]
+   #_[clj-stacktrace.repl]
    [clojure.stacktrace :as stack]
    [clojurescript-build.core :as cbuild]
    [clojurescript-build.auto :as auto]
@@ -22,7 +21,8 @@
       (util/sh (update-in command [:shell] (fn [old] (concat old [message]))))
       (catch Throwable e
         (println (auto/red "Error running :notify-command:"))
-        (stack/print-cause-trace e 1)
+        (stack/print-stack-trace e 30)
+        (flush)
         #_(clj-stacktrace.repl/pst+ e)))))

 (defn notify-on-complete [{:keys [build-options parsed-notify-command]}]
@@ -47,7 +47,8 @@

 (defn handle-exceptions [figwheel-server {:keys [build-options exception id] :as build}]
   (println (auto/red (str "Compiling \"" (:output-to build-options) "\" failed.")))
-  (stack/print-cause-trace exception 1)
+  (stack/print-stack-trace exception 30)
+  (flush)
   #_(clj-stacktrace.repl/pst+ exception)
   (fig/compile-error-occured
    (merge-build-into-server-state figwheel-server build)


Arnout waking up

Arnout waking up

--- systems/ring-analytics/src/containium/systems/ring_analytics.clj
+++ systems/ring-analytics/src/containium/systems/ring_analytics.clj
@@ -52,7 +52,7 @@
                             (assoc :started (time/format (time/datetime started)
                                                          :date-hour-minute-second-ms)
                                    ;; Maybe move the request parameters to a :request key as well?
-                                   :response (-> body
+                                   :response (-> response
                                                  (dissoc :body)
                                                  (assoc :took took)))
                             (when (instance? Throwable response)


Store ring response in analytics

Store ring response in analytics

--- systems/ring-analytics/src/containium/systems/ring_analytics.clj
+++ systems/ring-analytics/src/containium/systems/ring_analytics.clj
@@ -50,7 +50,9 @@
                             (dissoc :body :async-channel)
                             (assoc :started (time/format (time/datetime started)
                                                          :date-hour-minute-second-ms)
-                                   :took (- (System/currentTimeMillis) started))
+                                   :took (- (System/currentTimeMillis) started)
+                                   ;; Maybe move the request parameters to a :request key as well?
+                                   :response response)
                             (if (instance? Throwable response)
                               (assoc :failed (.getMessage ^Throwable response))
                               (assoc :status (:status response))))]


Spec integrant a.l.migrate component

Spec integrant a.l.migrate component

--- backend/src/akvo/lumen/migrate.clj
+++ backend/src/akvo/lumen/migrate.clj
@@ -5,6 +5,8 @@
    [clojure.java.io :as io]
    [clojure.tools.logging :as log]
    [duct.core :as duct]
+   [clojure.spec.alpha :as s]
+   [akvo.lumen.specs.components :refer (integrant-key)]
    [environ.core :refer [env]]
    [hugsql.core :as hugsql]
    [integrant.core :as ig]
@@ -110,3 +112,11 @@

 (defmethod ig/init-key :akvo.lumen.migrate [_ opts]
   opts)
+(s/def ::tenant-manager string?)
+(s/def ::tenants string?)
+(s/def ::migrations (s/keys :req-un [::tenant-manager ::tenants]))
+
+(defmethod integrant-key :akvo.lumen.migrate [_]
+  (s/cat :kw keyword?
+         :config (s/keys :req-un [::migrations])))
+


[#65] Migrate the db as part of system startup

--- backend/src/org/akvo/dash/main.clj
+++ backend/src/org/akvo/dash/main.clj
@@ -5,6 +5,7 @@
             [com.stuartsierra.component :as component]
             [duct.middleware.errors :refer [wrap-hide-errors]]
             [duct.util.runtime :refer [add-shutdown-hook]]
+            [duct.component.ragtime :as ragtime]
             [meta-merge.core :refer [meta-merge]]
             [org.akvo.dash.config :as config]
             [org.akvo.dash.system :refer [new-system]]))
@@ -23,4 +24,8 @@
   (let [system (new-system config)]
     (println "Starting HTTP server on port" (-> system :http :port))
     (add-shutdown-hook ::stop-system #(component/stop system))
-    (component/start system)))
+    (-> system
+        component/start
+        :ragtime
+        ragtime/reload
+        ragtime/migrate)))


:bug: Fix focus losing on text selection.

--- frontend/src/uxbox/main/ui/shapes/text.cljs
+++ frontend/src/uxbox/main/ui/shapes/text.cljs
@@ -227,7 +227,8 @@

         state    (mf/use-state #(parse-content content))
         editor   (mf/use-memo #(dwt/create-editor))
-        self-ref (mf/use-ref)
+        self-ref      (mf/use-ref)
+        selecting-ref (mf/use-ref)

         on-close
         (fn []
@@ -240,11 +241,22 @@
           (let [sidebar (dom/get-element "settings-bar")
                 cpicker (dom/get-element-by-class "colorpicker-tooltip")
                 self    (mf/ref-val self-ref)
-                target  (dom/get-target event)]
+                target  (dom/get-target event)
+                selecting? (mf/ref-val selecting-ref)]
             (when-not (or (.contains sidebar target)
                           (.contains self target)
                           (and cpicker (.contains cpicker target)))
-              (on-close))))
+              (if selecting?
+                (mf/set-ref-val! selecting-ref false)
+                (on-close)))))
+
+        on-mouse-down
+        (fn [event]
+          (mf/set-ref-val! selecting-ref true))
+
+        on-mouse-up
+        (fn [event]
+          (mf/set-ref-val! selecting-ref false))

         on-keyup
         (fn [event]
@@ -282,6 +294,8 @@
         :class "rich-text"
         :render-element render-element
         :render-leaf render-text
+        :on-mouse-up on-mouse-up
+        :on-mouse-down on-mouse-down
         :on-blur (fn [event]
                    (dom/prevent-default event)
                    (dom/stop-propagation event)


Made better filename.

Made better filename.

--- scripts/extract-ipip-neo-2413.clj
+++ scripts/extract-ipip-neo-2413.clj
@@ -7,7 +7,7 @@

 (def url "http://ipip.ori.org/new2413Items.htm")
 (def export-dir "target/json/")
-(def export-file (str export-dir "data.json"))
+(def export-file (str export-dir "ipip-neo-2413.json"))

 (util/make-dirs export-dir)


add debug to figure out why our wonderful env detection doesn't work

--- src/holston/core.clj
+++ src/holston/core.clj
@@ -26,6 +26,8 @@
       (throw (Exception. (str "Mandatory environment variable missing: " name)))))

 (defn get-oauth-callback-domain []
+  (println "ENV_DIR")
+  (println (System/getenv "ENV_DIR"))
   (if (System/getenv "ENV_DIR") ;; We're in Heroku, not local env
     (get-mandatory-env-var "HOLSTON_OATH2_CALLBACK_DOMAIN")
     "http://localhost:8080"))
@@ -109,4 +111,5 @@
 (defn -main
   "Starts the server"
   [port]
+  (println "Starting Holston")
   (run-server (site #'app) {:port (Integer. port)}))


doing some more design work

doing some more design work

--- src-cljs/mappt/components/header_sign_in.cljs
+++ src-cljs/mappt/components/header_sign_in.cljs
@@ -7,7 +7,10 @@
   (.log js/console "clicked!"))

 (defn modal-sign-in [state]
-  [:div {:class "modal"}])
+  [:div {:id "modal-container"}
+   [:div {:id "modal-header"}]
+   [:div {:id "modal-content"}]
+   [:div {:id "modal-footer"}]])

 (defn view-header-signed-in [state]
   (let [username (-> state :user :username)]


Time and refactor the api request functions

--- src/clj/com/beardandcode/twitter_news/api.clj
+++ src/clj/com/beardandcode/twitter_news/api.clj
@@ -10,7 +10,7 @@
             [com.stuartsierra.component :as component]
             [metrics.core :refer [new-registry]]
             [metrics.meters :refer [mark! meter]]
-            [metrics.timers :refer [timer time!]]
+            [metrics.timers :refer [timer] :as timers]
             [throttler.core :refer [throttle-chan]]
             [com.beardandcode.twitter-news.stats :as stats]))

@@ -32,60 +32,72 @@
 (def all-statuses [200 304 400 401 403 404 406 410 420 422 429 500 502 503 504])

 (defn- execute->json [request status-meters]
-  (log/infof "Requesting from %s" (.toString request))
-  (let [response (.execute (HttpClients/createDefault) request)
-        status-code (.getStatusCode (.getStatusLine response))
-        body-string (EntityUtils/toString (.getEntity response) "UTF-8")]
-    (.close response)
-    (if-let [meter (status-meters status-code)] (mark! meter))
-    (if (= status-code 429)
-      (let [limit-cleared-ms (-> response
-                                 (.getHeaders "X-Rate-Limit-Reset")
-                                 first (.getValue) Long/parseLong (* 1000))
-            until-cleared-ms (- limit-cleared-ms (System/currentTimeMillis))]
-        (log/infof "Rate was limited, clearing at %d so we are waiting for %dms"
-                  limit-cleared-ms until-cleared-ms)
-        (if (> until-cleared-ms 0) (async/<! (async/timeout until-cleared-ms)))
-        (execute->json request status-meters))
-      (json/parse-string body-string))))
+  (async/go
+    (log/infof "Requesting from %s" (.toString request))
+    (let [response (.execute (HttpClients/createDefault) request)
+          status-code (.getStatusCode (.getStatusLine response))
+          body-string (EntityUtils/toString (.getEntity response) "UTF-8")]
+      (.close response)
+      (if-let [meter (status-meters status-code)] (mark! meter))
+      (cond
+        (= status-code 200)
+        (json/parse-string body-string)
+
+        (= status-code 429)
+        (let [limit-cleared-ms (-> response
+                                   (.getHeaders "X-Rate-Limit-Reset")
+                                   first (.getValue) Long/parseLong (* 1000))
+              until-cleared-ms (- limit-cleared-ms (System/currentTimeMillis))]
+          (log/infof "Rate was limited, clearing at %d so we are waiting for %dms"
+                     limit-cleared-ms until-cleared-ms)
+          (if (> until-cleared-ms 0) (async/<! (async/timeout until-cleared-ms)))
+          (async/<! (execute->json request status-meters)))
+
+        (> status-code 500)
+        (do (async/<! (async/timeout 1000))
+            (async/<! (execute->json request status-meters)))
+
+        :else
+        (log/warnf "Response returned %d: %s" status-code body-string)))))
+
+(defn- dispatch-requests [request-chan request-fn auth name metrics-registry]
+  (let [control-chan (async/chan)
+        request-rate (meter metrics-registry (str name ".rate"))
+        response-timer (timer metrics-registry (str name ".response-time"))
+        status-meters (reduce #(assoc %1 %2 (meter metrics-registry (str name ".status." %2)))
+                              {} all-statuses)]
+    (log/infof "Dispatch[%s] starting" name)
+    (async/go-loop []
+      (let [[v ch] (async/alts! [request-chan control-chan])]
+        (if (= ch request-chan)
+          (let [{:keys [params out-chan]} v
+                timing (timers/start response-timer)
+                response (async/<! (execute->json (request-fn auth params) status-meters))]
+            (timers/stop timing)
+            (async/>! out-chan response)
+            (async/close! out-chan)
+            (mark! request-rate)
+            (recur))
+          (log/infof "Dispatch[%s] stopping" name))))
+    control-chan))

 (defn- throttled-requester [name metrics-registry auth request-fn num per-period]
   (let [request-chan (async/chan (stats/buffer (str name ".waiting") 100 metrics-registry))
         throttled-chan (throttle-chan request-chan num per-period)
-        control-chan (async/chan)
-        request-rate (meter metrics-registry (str name ".rate"))
-        response-timer (timer metrics-registry (str name ".response-time"))
-        status-meters (reduce #(assoc %1 %2 (meter metrics-registry (str name ".status." %2)))
-                              {} all-statuses)]
-    (log/infof "Requester[%s] starting" name)
-    (async/go-loop []
-      (let [[v ch] (async/alts! [throttled-chan control-chan])]
-        (if (= ch throttled-chan)
-          (let [{:keys [params out-chan]} v]
-            (async/>! out-chan (time! response-timer
-                                      (execute->json (request-fn auth params) status-meters)))
-            (async/close! out-chan)
-            (mark! request-rate)
-            (recur))
-          (log/infof "Requester[%s] stopping" name))))
-    (fn
-      ([] (async/>!! control-chan :kill))
-      ([params]
-       (let [out-chan (async/chan)]
-         (async/go (async/>! request-chan {:params params :out-chan out-chan}))
-         out-chan)))))
+        control-chan (dispatch-requests throttled-chan request-fn auth name metrics-registry)]
+    (fn ([] (async/>!! control-chan :kill))
+       ([params]
+        (let [out-chan (async/chan)]
+          (async/go (async/>! request-chan {:params params :out-chan out-chan}))
+          out-chan)))))

 (defn- all-tweets-from [requester user]
   (let [out-chan (async/chan)]
     (async/go-loop [response (async/<! (requester {"screen_name" user "count" 200}))]
       (if (> (count response) 0)
         (let [lowest-id (->> response
-                             (map #(if-let [id (get % "id_str")]
-                                     id
-                                     (do (println %) "0")))
-                             (map #(try
-                                     (Long/parseLong %)
-                                     (catch Exception e (println %) (.printStackTrace e))))
+                             (map #(get % "id_str"))
+                             (map #(Long/parseLong %))
                              sort first)]
           (doseq [tweet response] (async/>! out-chan tweet))
           (recur (async/<! (requester {"screen_name" user "count" 200 "max_id" (dec lowest-id)}))))


[#3045] Hide `Instance id` in the backend

We have explored the idea of hiding the the `Instance id` for
non-metadata groups in the client. The result is that some code uses
the Redux store (a central place for state) but other parts, like the
Grid, uses the direct response from the XHR call.

Hiding only visually in the Grid and Dropdowns makes us wonder how the
grid will behave if the server is responding more data than the
visible one. How this will play out when transformations are added.

For now it seems *safer* to filter the `hidden` columns in the
backend.

--- backend/src/akvo/lumen/lib/dataset.clj
+++ backend/src/akvo/lumen/lib/dataset.clj
@@ -98,7 +98,11 @@
       (let [dataset* (-> (select-keys (first data-groups)
                                       [:name :modified :created :updated :source :transformations])
                          (assoc :status "OK"))]
-        (lib/ok (assoc dataset*  :id id :groups (mapv (juxt :id :columns :repeatable) data-groups))))
+        (lib/ok (assoc dataset*  :id id :groups (->> data-groups
+                                                     (mapv (juxt :id :columns :repeatable))
+                                                     (mapv #(update % 1 (fn [cols]
+                                                                          (filter (fn [col]
+                                                                                (not (get col "hidden"))) cols))))))))
       (lib/not-found {:error "Not found"}))
     (if-let [dsv (db.dataset/dataset-by-id tenant-conn {:id id})]
       (let [dataset* (-> (select-keys dsv
@@ -145,18 +149,18 @@
   (if (get (env/all tenant-conn) "data-groups")
     (when-let [dg (db.dataset/data-group-by-dataset-id-and-group-id tenant-conn {:dataset-id id
                                                                                :group-id group-id})]
-      (let [q (select-data-sql (:table-name dg) (:columns dg))
+      (let [columns (filter #(not (get % "hidden")) (:columns dg))
+            q (select-data-sql (:table-name dg) columns)
             data (rest (jdbc/query tenant-conn
                                    [q]
                                    {:as-arrays? true}))]
         (-> (select-keys dg [:updated :created :modified :transformations])
             remove-token
             (assoc :rows data
-                   :columns (:columns dg)
+                   :columns columns
                    :status "OK" :datasetId id :groupId group-id))))
     (when-let [dsv (db.dataset/dataset-by-id tenant-conn {:id id})]
       (let [columns (get (groups dsv) group-id)
-            namespaces (set (map #(get % "namespace" "main") columns))
             q (select-data-sql (:table-name dsv) columns)
             data (rest (jdbc/query tenant-conn
                                    [q]


Added type information

Added type information

--- src/kixi/datastore/schemastore/conformers.clj
+++ src/kixi/datastore/schemastore/conformers.clj
@@ -4,9 +4,10 @@

 (defn str-double->int
   "1. or 1.0...0 will convert to 1"
-  [s]
+  [^String s]
   (some-> (re-find #"^([0-9]+)\.0*$" s)
           (last)
+          str
           (Integer/valueOf)))

 (defn double->int
@@ -27,7 +28,7 @@
         (and (string? x)
              (str-double->int x)) (str-double->int x)
         (string? x) (try
-                      (Integer/valueOf x)
+                      (Integer/valueOf (str x))
                       (catch Exception e
                         :clojure.spec/invalid))
         :else :clojure.spec/invalid))
@@ -43,7 +44,7 @@
     (clojure.core/double? x) x
     (clojure.core/integer? x) (double x)
     (string? x) (try
-                  (Double/valueOf x)
+                  (Double/valueOf (str x))
                   (catch Exception e
                     :clojure.spec/invalid))
     :else :clojure.spec/invalid))


finish refactoring transactions/create

finish refactoring transactions/create

--- src/clj_money/models/transactions.clj
+++ src/clj_money/models/transactions.clj
@@ -321,7 +321,7 @@
   (with-storage [s storage-spec]
     (let [records-affected (first (update-transaction-item-index-and-balance
                                     s
-                                    item))]
+                                    (before-save-item item)))]
       (> records-affected 0))))

 (defn- calculate-item-index-and-balance
@@ -345,10 +345,9 @@
         account (accounts/find-by-id storage (:account-id item)) ; TODO: remove redundant calls to find the account
         polarized-amount (accounts/polarize-amount item account)
         new-balance (+ balance polarized-amount)
-        value-changed (update-item-index-and-balance storage (-> item
-                                                                 (assoc :index new-index
-                                                                        :balance new-balance)
-                                                                 before-save-item))
+        value-changed (update-item-index-and-balance storage (assoc item
+                                                                    :index new-index
+                                                                    :balance new-balance))
         result {:index new-index
                 :balance new-balance
                 :storage storage}]
@@ -490,12 +489,13 @@
        (create-transaction-item storage)
        after-item-read))

-(defn- update-account-balances
-  [& args]
-
-  (pprint {:update-account-balances args})
-
-  )
+(defn search-items
+  "Returns transaction items matching the specified criteria"
+  ([storage-spec criteria]
+   (search-items storage-spec criteria {}))
+  ([storage-spec criteria options]
+   (with-storage [s storage-spec]
+     (map after-item-read (select-transaction-items s criteria options)))))

 (defn- recalculate-account-items
   "Accepts a tuple containing an account-id and a base item,
@@ -506,25 +506,33 @@
   or nil if te balance didn't change."
   [storage [account-id base-item]]
   (let [account (accounts/find-by-id storage account-id)
-        items (search-items storage {:account-id account-id
-                                     :transaction-date [:between
-                                                        (:transaction-date base-item)
-                                                        (t/today)]})] ; TODO: use last partition value
-    (reduce (fn [context item]
-              (let [new-index (+ 1 (:last-index context))
-                    polarized-amount (accounts/polarize-amount account (:balance item))
-                    new-balance (+ (:last-balance context)
-                                   polarized-amount)
-                    changed (update-item storage (assoc item :index new-index :balance new-balance))]
-                (assoc context :last-index new-index
-                               :last-balance new-balance)))
-            ; TODO short circuit if no change
-            {:last-index 0
-             :last-balance 0M}
-            items))
-
-  ; TOTO: return the account-id and the new balance (or nil)
-  )
+        items (search-items storage
+                            {:account-id account-id
+                             :transaction-date [:between
+                                                (:transaction-date base-item)
+                                                (t/today)]} ; TODO: use last partition value
+                            {:sort [:transaction-date :index]})
+        result (reduce (fn [context item]
+                         (let [new-index (+ 1 (:last-index context))
+                               polarized-amount (accounts/polarize-amount item account)
+                               new-balance (+ (:last-balance context)
+                                              polarized-amount)
+                               changed (update-item-index-and-balance
+                                         storage
+                                         (assoc item
+                                                :index new-index
+                                                :balance new-balance))
+                               updated (assoc context
+                                              :last-index new-index
+                                              :last-balance new-balance)]
+                           (if changed
+                             updated
+                             (reduced (dissoc updated :last-balance)))))
+                       {:last-index 0
+                        :last-balance 0M}
+                       items)]
+    (when-let [last-balance (:last-balance result)]
+      (accounts/update storage (assoc account :balance last-balance)))))

 (defn- recalculate-items
   "Accepts a list of transaction items and processes items
@@ -533,10 +541,8 @@
   [storage base-items]
   (->> base-items
        (group-by :account-id)
-       (map (fn [[account-id items]
-                 [account-id (first items)]]))
-       (map (partial recalculate-account-items storage))
-       (update-account-balances storage)))
+       (map #(update-in % [1] first))
+       (mapv (partial recalculate-account-items storage))))

 (defn- create-transaction-and-adjust-balances
   [storage transaction]
@@ -775,14 +781,6 @@
       (:balance t)
       0M)))

-(defn search-items
-  "Returns transaction items matching the specified criteria"
-  [storage-spec criteria]
-  (with-storage [s storage-spec]
-    (->> criteria
-         (select-transaction-items s)
-         (map after-item-read))))
-
 (defn find-items-by-ids
   [storage-spec ids date-range]
   (search-items


add missing require

add missing require

--- src/clj_money/models/transactions.clj
+++ src/clj_money/models/transactions.clj
@@ -5,6 +5,7 @@
             [clojure.set :refer [difference]]
             [clj-time.coerce :as tc]
             [clj-money.util :refer [ensure-local-date]]
+            [clj-money.coercion :as coercion]
             [clj-money.validation :as validation]
             [clj-money.models.accounts :as accounts]
             [clj-money.models.helpers :refer [with-storage with-transacted-storage]]


Sort completion suggestions

Sort completion suggestions

--- src/clojure/nightcode/completions.clj
+++ src/clojure/nightcode/completions.clj
@@ -50,6 +50,7 @@
                        (map #(get-clojure-completions prefix %))
                        flatten
                        set
+                       (sort-by :symbol-str)
                        (map #(create-completion this (:symbol-str %) (:doc-str %)))
                        doall)))
               (catch Exception _))


`move-once-to-core` didn't work for macros

--- src/midje/clojure/backwards_compatibility.clj
+++ src/midje/clojure/backwards_compatibility.clj
@@ -17,8 +17,8 @@
       `(do
          (require '~source-namespace)
          (doseq [sym# '~syms]
-           (intern 'clojure.core sym# (ns-resolve '~source-namespace sym#)))))))
-
+           (let [var# (ns-resolve '~source-namespace sym#)]
+             (intern 'clojure.core (with-meta sym# (meta var#)) var#)))))))

 (move-once-to-core slingshot.ex-info [ex-info ex-data])
 (move-once-to-core midje.clojure.one-dot-five [cond-> cond->> as-> some-> some->>])


Renamed "stem-.*" to "canonical-.*" in test cases for implications

Signed-off-by: Daniel Borchmann <25857343a15bf1edafebc2912e82ecf775c585c1@mailbox.tu-dresden.de>

--- src/conexp/tests/fca/implications.clj
+++ src/conexp/tests/fca/implications.clj
@@ -171,15 +171,15 @@
     (is (sound-implication-set? ctx irr-subset))
     (is (complete-implication-set? ctx irr-subset))))

-(def stem-base-test-contexts [contexts/test-ctx-01,
-                              contexts/test-ctx-04
-                              contexts/test-ctx-07,
-                              contexts/test-ctx-08])
-
-(deftest test-stem-base
-  (is (= 1 (count (stem-base (one-context #{1 2 3 4 5})))))
-  (doseq [ctx stem-base-test-contexts]
-    (let [sb (stem-base ctx)]
+(def canonical-base-test-contexts [contexts/test-ctx-01,
+                                   contexts/test-ctx-04
+                                   contexts/test-ctx-07,
+                                   contexts/test-ctx-08])
+
+(deftest test-canonical-base
+  (is (= 1 (count (canonical-base (one-context #{1 2 3 4 5})))))
+  (doseq [ctx canonical-base-test-contexts]
+    (let [sb (canonical-base ctx)]
       (is (minimal-implication-set? sb))
       (is (sound-implication-set? ctx sb))
       (is (complete-implication-set? ctx sb))
@@ -189,7 +189,7 @@
                 (=> (proper-subset? Y X)
                     (proper-subset? (adprime ctx Y) X)))))))))

-(deftest test-stem-base-with-background-knowledge
+(deftest test-canonical-base-with-background-knowledge
   ;; make sure implications with empty premise are handled correctly
   (is (let [ctx (make-context-from-matrix 5 5
                                           [0 0 1 0 1
@@ -203,8 +203,8 @@
              (impl 2 3 ==> 4)
              (impl 1 2 4 ==> 0 3)}))))

-(deftest test-stem-base-with-minimal-support-constraints
-  (with-testing-data [ctx stem-base-test-contexts
+(deftest test-canonical-base-with-minimal-support-constraints
+  (with-testing-data [ctx canonical-base-test-contexts
                       mis [0 1/5 1/3 1/2 4/5 1]]
     (= (set (filter #(<= mis (support % ctx))
                     (canonical-base ctx)))
@@ -213,7 +213,7 @@
 (deftest test-pseudo-intents
   (with-testing-data [ctx (random-contexts 10 20)]
     (= (set (pseudo-intents ctx))
-       (set (map premise (stem-base ctx)))))
+       (set (map premise (canonical-base ctx)))))
   (is (empty? (pseudo-intents (adiag-context [0 1 2 3]))))
   (is (empty? (pseudo-intents (adiag-context [nil true adiag-context])))))

@@ -262,21 +262,21 @@
                     [3 5] [3 8] [4 1] [4 3] [4 5]
                     [4 8] [5 2] [5 3] [5 5] [5 7]})))

-(deftest test-stem-base-from-base
+(deftest test-canonical-base-from-base
   (with-testing-data [ctx (random-contexts 10 20)]
-    (= (set (stem-base ctx))
-       (stem-base-from-base (proper-premise-implications ctx))))
-  (= (stem-base-from-base [(make-implication #{1} #{2 3})
+    (= (set (canonical-base ctx))
+       (canonical-base-from-base (proper-premise-implications ctx))))
+  (= (canonical-base-from-base [(make-implication #{1} #{2 3})
                            (make-implication #{1} #{2 4})])
      #{(make-implication #{1} #{2 3 4})}))

 (deftest test-canonical-base-from-clop
-  (with-testing-data [ctx stem-base-test-contexts]
+  (with-testing-data [ctx canonical-base-test-contexts]
     (and (= (set (canonical-base ctx))
             (set (canonical-base-from-clop #(adprime ctx %) (attributes ctx)))))))

 (deftest test-parallel-canonical-base-from-clop
-  (with-testing-data [ctx stem-base-test-contexts]
+  (with-testing-data [ctx canonical-base-test-contexts]
     (and (= (set (canonical-base ctx))
             (set (parallel-canonical-base-from-clop #(adprime ctx %)
                                                     (attributes ctx)))))))
@@ -306,7 +306,7 @@
              (impl 1 2 4 ==> 0 3)}))))

 (deftest test-intersect-implicational-theories
-  (with-testing-data [ctx stem-base-test-contexts,
+  (with-testing-data [ctx canonical-base-test-contexts,
                       n   (range 1 (count (objects ctx)))]
     (= (set (canonical-base ctx))
        (set (apply intersect-implicational-theories (attributes ctx)


Thread-first wasn't adding clarity.

Thread-first wasn't adding clarity.

--- src/klangmeister/sound/synthesis.cljs
+++ src/klangmeister/sound/synthesis.cljs
@@ -86,7 +86,7 @@
   [upstream-synth downstream-synth]
   (fapply
     (fn [graph1 graph2]
-      (-> (:output graph1) (.connect (:input graph2)))
+      (.connect (:output graph1) (:input graph2))
       (section (:input graph1) (:output graph2)))
     upstream-synth
     downstream-synth))


We are Microsoft now!

We are Microsoft now!

--- src/leiningen/new/cljskel/project.clj
+++ src/leiningen/new/cljskel/project.clj
@@ -78,7 +78,7 @@

   :rpm {:name "{{lower-name}}"
         :summary "RPM for {{upper-name}} service"
-        :copyright "Nokia {{year}}"
+        :copyright "Microsfot {{year}}"
         :preinstall {:scriptFile "scripts/rpm/preinstall.sh"}
         :postinstall {:scriptFile "scripts/rpm/postinstall.sh"}
         :preremove {:scriptFile "scripts/rpm/preremove.sh"}


exclude alias, cljs alias macro needs to deal with quoted symbols

--- src/main/clojure/cljs/core/macros.clj
+++ src/main/clojure/cljs/core/macros.clj
@@ -7,11 +7,13 @@
 ;   You must not remove this notice, or any other, from this software.

 (ns cljs.core.macros
-  (:refer-clojure :exclude [binding])
-  (:require [cljs.repl :refer [source]]))
+  (:refer-clojure :exclude [binding alias])
+  (:require [cljs.env :as env]
+            [cljs.analyzer :as ana]
+            [cljs.repl :refer [source]]))

 (defmacro import-macros [ns [& vars]]
   )

-(defmacro alias [ns alias]
+(defmacro alias [[_ ns] [_ alias]]
   )


Add setup/teardown/using-contexts

Add setup/teardown/using-contexts

--- src/main/clojure/lazytest/context.clj
+++ src/main/clojure/lazytest/context.clj
@@ -2,14 +2,16 @@
   "Contexts provide context and/or state in which to run one or more
   tests.")

-(defn context [setup-fn teardown-fn]
+(defn context
+  "Creates a context with the given setup and teardown functions."
+  [setup-fn teardown-fn]
   {:pre [(fn? setup-fn) (fn? teardown-fn)]}
   (with-meta {:setup setup-fn, :teardown teardown-fn} {:type ::context}))

 (defn context?
   "Returns true if x is a context."
   [x]
-  (= ::context (type x)))
+  (isa? (type x) ::context))

 (defn memoized-context
   "Returns a context whose setup method calls, returns, and caches the
@@ -33,3 +35,33 @@
   [c]
   {:pre [(context? c)]}
   ((:teardown c)))
+
+(defn add-context
+  "Adds context c to metadata of iobj."
+  [iobj c]
+  {:pre [(context? c)]}
+  (vary-meta iobj update-in [::contexts] conj c))
+
+(defn setup-contexts
+  "Run setup functions of all contexts in iobj's metadata."
+  [iobj]
+  (doseq [c (::contexts (meta iobj))]
+    (setup c)))
+
+(defn teardown-contexts
+  "Run teardown functions of all contexts in iobj's metadata."
+  [iobj]
+  (doseq [c (reverse (::contexts (meta iobj)))]
+    (teardown c)))
+
+(defn using-contexts
+  "Returns a no-argument function applying f to the values returned by
+  the setup function of contexts cs.  Ensures that the teardown
+  functions of all contexts are called.
+
+  The returned function has the same metadata as f."
+  [f & cs]
+  {:pre [(fn? f) (every? context? cs)]}
+  (with-meta (fn [] (try (apply f (map setup cs))
+			 (finally (dorun (map teardown cs)))))
+    (meta f)))