pva-trans is creating PVA Schema after ETL of ArgusMart data

--- src/pg_demo/pva_trans.clj
+++ src/pg_demo/pva_trans.clj
@@ -20,457 +20,457 @@

 (def pva-trans
   "The tranformation from ArgusMart schema to PVA schema"
-  {
-    :case_assess
-       "select
-          a.case_id,
-          a.listedness,
-          a.outcome,
-          a.seriousness,
-          a.agent_suspect,
-          a.company_diagnosis,
-          b.version_num,
-          b.effective_start_date,
-          b.effective_end_date,
-          a.enterprise_id
-        from
-          rm_case_assess as a,
-          case_version_table as b
-        where
-          (a.case_id = b.case_id) and
-          (a.enterprise_id = b.enterprise_id) and
-          (a.deleted_flag = 0) and
-          (a.effective_start_date <= b.effective_start_date) and
-          (a.effective_end_date > b.effective_start_date) "
-
-    :case_classifications
-       "select
-          a.enterprise_id,
-          a.enterprise_id,
-          a.case_id,
-          a.seq_num,
-          a.classification_id,
-          a.deleted,
-          b.version_num,
-          b.effective_start_date,
-          b.effective_end_date
-        from
-          rm_case_classifications as a,
-          case_version_table as b
-        where
-          (a.case_id = b.case_id) and
-          (a.effective_start_date <= b.effective_start_date) and
-          (a.effective_end_date > b.effective_start_date) "
-
-    :case_event
-       "select
-          a.enterprise_id,
-          a.case_id,
-          a.seq_num,
-          a.desc_reptd,
-          a.desc_coded,
-          a.diagnosis,
-          a.onset,
-          a.onset_res,
-          a.onset_delay,
-          a.stop_date,
-          a.stop_date_res,
-          a.duration,
-          a.onset_latency,
-          a.evt_intensity_id,
-          a.evt_freq_id,
-          a.treated,
-          a.study_related,
-          a.rechall_related,
-          a.prod_seq_num,
-          a.evt_outcome_id,
-          a.receipt_date,
-          a.rpt_serious,
-          a.sc_death,
-          a.sc_hosp,
-          a.sc_cong_anom,
-          a.sc_threat,
-          a.sc_disable,
-          a.sc_int_req,
-          a.sc_other,
-          a.sc_other_text,
-          a.art_code,
-          a.pref_term,
-          a.inc_term,
-          a.body_sys,
-          a.med_serious,
-          a.past_hist,
-          a.dict_id,
-          a.dict_key,
-          a.code_status,
-          a.seriousness,
-          a.sort_id,
-          a.onset_date_partial,
-          a.stop_date_partial,
-          a.efficacy,
-          a.disease,
-          a.withdrawal,
-          a.hlgt,
-          a.hlt,
-          a.hlt_code,
-          a.hlgt_code,
-          a.soc_code,
-          a.study_dropped,
-          a.inc_code,
-          a.onset_minutes,
-          a.delay_minutes,
-          b.version_num,
-          b.effective_start_date,
-          b.effective_end_date
-        from
-          rm_case_event as a,
-          case_version_table as b
-        where
-          (a.case_id = b.case_id) and
-          (a.enterprise_id = b.enterprise_id) and
-          (a.deleted_flag = 0) and
-          (a.effective_start_date <= b.effective_start_date) and
-          (a.effective_end_date > b.effective_start_date) "
-
-    :case_event_assess
-       "select
-          a.case_id,
-          a.prod_seq_num,
-          a.event_seq_num,
-          a.license_id,
-          a.datasheet_id,
-          a.source_id,
-          a.det_causality_id,
-          a.seq_num,
-          a.causality_score,
-          a.cause_justify,
-          a.listed_justify,
-          a.causality_assessment,
-          a.det_listedness_id,
-          a.rpt_causality_id,
-          a.prt_causality_id,
-          b.version_num,
-          b.effective_start_date,
-          b.effective_end_date,
-          a.enterprise_id
-        from
-          rm_case_event_assess as a,
-          case_version_table as b
-        where
-          (a.case_id = b.case_id) and
-          (a.enterprise_id = b.enterprise_id) and
-          (a.deleted_flag = 0) and
-          (a.effective_start_date <= b.effective_start_date) and
-          (a.effective_end_date > b.effective_start_date) "
-
-    :case_followup
-       "select
-          cf.case_id
-          cf.seq_num
-          cf.auditlog_type
-          cf.time_stamp
-          cf.receipt_date,
-          cf.safety_date
-          cf.significant
-          cvt.version_num
-          cvt.effective_start_date,
-          cvt.effective_end_date
-          cf.enterprise_id
-        from
-          rm_case_followup as cf,
-          case_version_table as cvt
-        where
-          (cf.case_id = cvt.case_id) and
-          (cf.enterprise_id = cvt.enterprise_id) and
-          (cf.effective_start_date <= cvt.effective_start_date) and
-          (cf.effective_end_date > cvt.effective_start_date) and
-          (cf.deleted_flag = 0) "
-
-    :case_master
-       "select
-          cm.case_id
-          cm.global_num
-          cm.initial_justification
-          cm.workflow_seq_num,
-          cm.owner_id
-          cm.site_id
-          cm.susar
-          cm.close_user_id
-          cm.close_date,
-          cm.date_locked
-          cm.close_notes
-          cm.state_id
-          cm.last_state_id,
-          cm.requires_followup
-          cm.due_soon
-          cm.create_time
-          cm.followup_date,
-          cm.init_rept_date
-          cm.last_update_time
-          cm.safety_date
-          cm.worklist_owner_id,
-          cm.case_num
-          cm.e2b_ww_number
-          cm.country_id
-          cm.rpt_type_id
-          cm.user_id,
-          cm.last_update_user_id
-          cm.seriousness
-          cvt.version_num
-          cvt.effective_start_date,
-          cvt.effective_end_date
-          cm.enterprise_id
-        from
-          rm_case_master as cm,
-          case_version_table as cvt
-        where
-          (cvt.case_id = cm.case_id) and
-          (cvt.effective_start_date >= cm.effective_start_date) and
-          (cvt.effective_start_date < cm.effective_end_date) and
-          (cm.deleted_flag = 0) and
-          (cm.enterprise_id = cvt.enterprise_id) "
-
-    :case_narrative
-       "select
-          a.enterprise_id
-          a.case_id
-          a.abbrev_narrative
-          a.abbrev_narrative_j
-          a.narrative,
-          a.narrative_j
-          b.version_num
-          b.effective_start_date
-          b.effective_end_date
-        from
-          rm_case_narrative as a,
-          case_version_table as b
-        where
-          (a.case_id = b.case_id) and
-          (a.effective_start_date <= b.effective_start_date) and
-          (a.effective_end_date > b.effective_start_date) "
-
-    :case_pat_info
-       "select
-          a.case_id
-          a.age_group_id
-          a.ethnicity_id
-          a.gender_id
-          a.pat_age
-          a.pat_subj_num,
-          a.pat_stat_preg
-          a.age_unit_id
-          b.version_num
-          b.effective_start_date,
-          b.effective_end_date
-          a.enterprise_id
-        from
-          rm_case_pat_info as a,
-          case_version_table as b
-        where
-          (a.case_id = b.case_id) and
-          (a.enterprise_id = b.enterprise_id) and
-          (a.deleted_flag = 0) and
-          (a.effective_start_date <= b.effective_start_date) and
-          (a.effective_end_date > b.effective_start_date) "
-
-    :case_prod_drugs
-       "select
-          a.case_id
-          a.seq_num
-          a.latency_seconds
-          a.rechall_stop
-          a.rechall_start,
-          a.total_dose
-          a.tampering
-          a.overdose
-          a.protocol
-          a.rechall_outcome,
-          a.rechallenge
-          a.n_siblings
-          a.cumulative_dose_unit_id
-          a.obtain_drug_country_id,
-          a.drug_auth_country_id
-          a.cumulative_dose
-          a.abuse
-          a.contraind
-          a.dechallenge,
-          a.act_taken_id
-          a.conc_units_id
-          a.formulation_id
-          a.concentration
-          a.severity_id,
-          a.interaction
-          a.prev_use
-          a.dechall_date
-          a.first_dose
-          a.last_dose,
-          a.duration_seconds
-          b.version_num
-          b.effective_start_date
-          b.effective_end_date,
-          a.enterprise_id
-          a.first_dose_partial
-          a.last_dose_partial
-        from
-          rm_case_prod_drugs as a,
-          case_version_table as b
-        where
-          (a.case_id = b.case_id) and
-          (a.enterprise_id = b.enterprise_id) and
-          (a.deleted_flag = 0) and
-          (a.effective_start_date <= b.effective_start_date) and
-          (a.effective_end_date > b.effective_start_date) "
-
-    :case_product
-       "select
-          cp.sdrug_not_admin
-          cp.prod_reptd
-          cp.prod_coded
-          cp.case_id
-          cp.family_id,
-          cp.seq_num
-          cp.product_id
-          cp.drug_type
-          cp.pat_exposure
-          cp.manufacturer_id,
-          cp.first_sus_prod
-          cp.country_id
-          cp.who_drug_code
-          cp.co_drug_code,
-          cp.product_name
-          cp.generic_name
-          cvt.version_num
-          cvt.effective_start_date,
-          cvt.effective_end_date
-          cp.enterprise_id
-          cp.sort_id
-        from
-          rm_case_product as cp,
-          case_version_table as cvt
-        where
-          (cp.case_id = cvt.case_id) and
-          (cp.enterprise_id = cvt.enterprise_id) and
-          (cp.effective_start_date <= cvt.effective_start_date) and
-          (cp.effective_end_date > cvt.effective_start_date) and
-          (cp.deleted_flag = 0) "
-
-    :case_reporters
-       "select
-          a.enterprise_id,
-          a.case_id,
-          a.seq_num,
-          a.media_id,
-          a.occupation_id,
-          a.hcp_flag,
-          a.primary_contact,
-          a.corr_contact,
-          a.reporter_type,
-          a.intermediary_id,
-          a.rpt_sent,
-          a.sort_id,
-          a.confidential,
-          a.country_id,
-          a.reporter_id,
-          a.institution,
-          a.institution_id,
-          b.version_num,
-          b.effective_start_date,
-          b.effective_end_date
-        from
-          rm_case_reporters as a,
-          case_version_table as b
-        where
-          (a.case_id = b.case_id) and
-          (a.enterprise_id = b.enterprise_id) and
-          (a.deleted_flag = 0) and
-          (a.effective_start_date <= b.effective_start_date) and
-          (a.effective_end_date > b.effective_start_date) "
-
-    :case_study
-       "select
-          a.case_id,
-          a.blind_name,
-          a.center_id,
-          a.classification_id,
-          a.code_broken,
-          a.dev_phase_id,
-          a.other_id,
-          a.study_desc,
-          a.study_key,
-          a.study_num,
-          b.version_num,
-          b.effective_start_date,
-          b.effective_end_date,
-          a.enterprise_id
-        from
-          rm_case_study as a,
-          case_version_table as b
-        where
-          (a.case_id = b.case_id) and
-          (a.enterprise_id = b.enterprise_id) and
-          (a.deleted_flag = 0) and
-          (a.effective_start_date <= b.effective_start_date) and
-          (a.effective_end_date > b.effective_start_date) "
-
-    :lm_case_classification
-       "select * from rm_lm_case_classification "
-
-    :lm_causality
-       "select * from rm_lm_causality "
-
-    :lm_countries
-       "select * from rm_lm_countries "
-
-    :lm_product
-       "select
-          enterprise_id,
-          product_id,
-          prod_name,
-          family_id,
-          formulation_id,
-          manufacturer_id,
-          concentration,
-          conc_unit_id,
-          indication_id,
-          code_dict,
-          indication_text,
-          intl_birth_date,
-          model_no,
-          drug_code,
-          prod_generic_name,
-          ind_llt_code,
-          ind_llt,
-          ind_hlt_code,
-          ind_hlt,
-          ind_hlgt_code,
-          ind_hlgt,
-          ind_soc_code,
-          ind_soc,
-          ind_syn_code,
-          ind_code_status,
-          prod_name_abbrv,
-          ind_coded,
-          ind_reptd
-        from
-          rm_lm_product
-        where
-          deleted is null "
-
-    :lm_product_family
-       "select
-          t.enterprise_id,
-          t.family_id,
-          t.name,
-          t.primary_view,
-          t.product_group_id,
-          t.deleted,
-          t.name_j
-        from
-          rm_lm_product_family t"
-
-    :lm_report_type
-       "select * from rm_lm_report_type "
-  } )
+  (into (sorted-map)
+    {
+      :case_assess
+         "select
+            a.case_id,
+            a.listedness,
+            a.outcome,
+            a.seriousness,
+            a.agent_suspect,
+            a.company_diagnosis,
+            b.version_num,
+            b.effective_start_date,
+            b.effective_end_date,
+            a.enterprise_id
+          from
+            rm_case_assess as a,
+            case_version_table as b
+          where
+            (a.case_id = b.case_id) and
+            (a.enterprise_id = b.enterprise_id) and
+            (a.deleted_flag = 0) and
+            (a.effective_start_date <= b.effective_start_date) and
+            (a.effective_end_date > b.effective_start_date) "
+
+      :case_classifications
+         "select
+            a.enterprise_id,
+            a.case_id,
+            a.seq_num,
+            a.classification_id,
+            a.deleted,
+            b.version_num,
+            b.effective_start_date,
+            b.effective_end_date
+          from
+            rm_case_classifications as a,
+            case_version_table as b
+          where
+            (a.case_id = b.case_id) and
+            (a.effective_start_date <= b.effective_start_date) and
+            (a.effective_end_date > b.effective_start_date) "
+
+      :case_event
+         "select
+            a.enterprise_id,
+            a.case_id,
+            a.seq_num,
+            a.desc_reptd,
+            a.desc_coded,
+            a.diagnosis,
+            a.onset,
+            a.onset_res,
+            a.onset_delay,
+            a.stop_date,
+            a.stop_date_res,
+            a.duration,
+            a.onset_latency,
+            a.evt_intensity_id,
+            a.evt_freq_id,
+            a.treated,
+            a.study_related,
+            a.rechall_related,
+            a.prod_seq_num,
+            a.evt_outcome_id,
+            a.receipt_date,
+            a.rpt_serious,
+            a.sc_death,
+            a.sc_hosp,
+            a.sc_cong_anom,
+            a.sc_threat,
+            a.sc_disable,
+            a.sc_int_req,
+            a.sc_other,
+            a.sc_other_text,
+            a.art_code,
+            a.pref_term,
+            a.inc_term,
+            a.body_sys,
+            a.med_serious,
+            a.past_hist,
+            a.dict_id,
+            a.dict_key,
+            a.code_status,
+            a.seriousness,
+            a.sort_id,
+            a.onset_date_partial,
+            a.stop_date_partial,
+            a.efficacy,
+            a.disease,
+            a.withdrawal,
+            a.hlgt,
+            a.hlt,
+            a.hlt_code,
+            a.hlgt_code,
+            a.soc_code,
+            a.study_dropped,
+            a.inc_code,
+            a.onset_minutes,
+            a.delay_minutes,
+            b.version_num,
+            b.effective_start_date,
+            b.effective_end_date
+          from
+            rm_case_event as a,
+            case_version_table as b
+          where
+            (a.case_id = b.case_id) and
+            (a.enterprise_id = b.enterprise_id) and
+            (a.deleted_flag = 0) and
+            (a.effective_start_date <= b.effective_start_date) and
+            (a.effective_end_date > b.effective_start_date) "
+
+      :case_event_assess
+         "select
+            a.case_id,
+            a.prod_seq_num,
+            a.event_seq_num,
+            a.license_id,
+            a.datasheet_id,
+            a.source_id,
+            a.det_causality_id,
+            a.seq_num,
+            a.causality_score,
+            a.cause_justify,
+            a.listed_justify,
+            a.causality_assessment,
+            a.det_listedness_id,
+            a.rpt_causality_id,
+            a.prt_causality_id,
+            b.version_num,
+            b.effective_start_date,
+            b.effective_end_date,
+            a.enterprise_id
+          from
+            rm_case_event_assess as a,
+            case_version_table as b
+          where
+            (a.case_id = b.case_id) and
+            (a.enterprise_id = b.enterprise_id) and
+            (a.deleted_flag = 0) and
+            (a.effective_start_date <= b.effective_start_date) and
+            (a.effective_end_date > b.effective_start_date) "
+
+      :case_followup
+         "select
+            cf.case_id,
+            cf.seq_num,
+            cf.auditlog_type,
+            cf.time_stamp,
+            cf.receipt_date,
+            cf.safety_date,
+            cf.significant,
+            cvt.version_num,
+            cvt.effective_start_date,
+            cvt.effective_end_date,
+            cf.enterprise_id
+          from
+            rm_case_followup as cf,
+            case_version_table as cvt
+          where
+            (cf.case_id = cvt.case_id) and
+            (cf.enterprise_id = cvt.enterprise_id) and
+            (cf.effective_start_date <= cvt.effective_start_date) and
+            (cf.effective_end_date > cvt.effective_start_date) and
+            (cf.deleted_flag = 0) "
+
+      :case_master
+         "select
+            cm.case_id,
+            cm.global_num,
+            cm.initial_justification,
+            cm.workflow_seq_num,
+            cm.owner_id,
+            cm.site_id,
+            cm.susar,
+            cm.close_user_id,
+            cm.close_date,
+            cm.date_locked,
+            cm.close_notes,
+            cm.state_id,
+            cm.last_state_id,
+            cm.requires_followup,
+            cm.due_soon,
+            cm.create_time,
+            cm.followup_date,
+            cm.init_rept_date,
+            cm.last_update_time,
+            cm.safety_date,
+            cm.worklist_owner_id,
+            cm.case_num,
+            cm.e2b_ww_number,
+            cm.country_id,
+            cm.rpt_type_id,
+            cm.user_id,
+            cm.last_update_user_id,
+            cm.seriousness,
+            cvt.version_num,
+            cvt.effective_start_date,
+            cvt.effective_end_date,
+            cm.enterprise_id
+          from
+            rm_case_master as cm,
+            case_version_table as cvt
+          where
+            (cvt.case_id = cm.case_id) and
+            (cvt.effective_start_date >= cm.effective_start_date) and
+            (cvt.effective_start_date < cm.effective_end_date) and
+            (cm.deleted_flag = 0) and
+            (cm.enterprise_id = cvt.enterprise_id) "
+
+      :case_narrative
+         "select
+            a.enterprise_id,
+            a.case_id,
+            a.abbrev_narrative,
+            a.abbrev_narrative_j,
+            a.narrative,
+            a.narrative_j,
+            b.version_num,
+            b.effective_start_date,
+            b.effective_end_date
+          from
+            rm_case_narrative as a,
+            case_version_table as b
+          where
+            (a.case_id = b.case_id) and
+            (a.effective_start_date <= b.effective_start_date) and
+            (a.effective_end_date > b.effective_start_date) "
+
+      :case_pat_info
+         "select
+            a.case_id,
+            a.age_group_id,
+            a.ethnicity_id,
+            a.gender_id,
+            a.pat_age,
+            a.pat_subj_num,
+            a.pat_stat_preg,
+            a.age_unit_id,
+            b.version_num,
+            b.effective_start_date,
+            b.effective_end_date,
+            a.enterprise_id
+          from
+            rm_case_pat_info as a,
+            case_version_table as b
+          where
+            (a.case_id = b.case_id) and
+            (a.enterprise_id = b.enterprise_id) and
+            (a.deleted_flag = 0) and
+            (a.effective_start_date <= b.effective_start_date) and
+            (a.effective_end_date > b.effective_start_date) "
+
+      :case_prod_drugs
+         "select
+            a.case_id,
+            a.seq_num,
+            a.latency_seconds,
+            a.rechall_stop,
+            a.rechall_start,
+            a.total_dose,
+            a.tampering,
+            a.overdose,
+            a.protocol,
+            a.rechall_outcome,
+            a.rechallenge,
+            a.n_siblings,
+            a.cumulative_dose_unit_id,
+            a.obtain_drug_country_id,
+            a.drug_auth_country_id,
+            a.cumulative_dose,
+            a.abuse,
+            a.contraind,
+            a.dechallenge,
+            a.act_taken_id,
+            a.conc_units_id,
+            a.formulation_id,
+            a.concentration,
+            a.severity_id,
+            a.interaction,
+            a.prev_use,
+            a.dechall_date,
+            a.first_dose,
+            a.last_dose,
+            a.duration_seconds,
+            b.version_num,
+            b.effective_start_date,
+            b.effective_end_date,
+            a.enterprise_id,
+            a.first_dose_partial,
+            a.last_dose_partial
+          from
+            rm_case_prod_drugs as a,
+            case_version_table as b
+          where
+            (a.case_id = b.case_id) and
+            (a.enterprise_id = b.enterprise_id) and
+            (a.deleted_flag = 0) and
+            (a.effective_start_date <= b.effective_start_date) and
+            (a.effective_end_date > b.effective_start_date) "
+
+      :case_product
+         "select
+            cp.sdrug_not_admin,
+            cp.prod_reptd,
+            cp.prod_coded,
+            cp.case_id,
+            cp.family_id,
+            cp.seq_num,
+            cp.product_id,
+            cp.drug_type,
+            cp.pat_exposure,
+            cp.manufacturer_id,
+            cp.first_sus_prod,
+            cp.country_id,
+            cp.who_drug_code,
+            cp.co_drug_code,
+            cp.product_name,
+            cp.generic_name,
+            cvt.version_num,
+            cvt.effective_start_date,
+            cvt.effective_end_date,
+            cp.enterprise_id,
+            cp.sort_id
+          from
+            rm_case_product as cp,
+            case_version_table as cvt
+          where
+            (cp.case_id = cvt.case_id) and
+            (cp.enterprise_id = cvt.enterprise_id) and
+            (cp.effective_start_date <= cvt.effective_start_date) and
+            (cp.effective_end_date > cvt.effective_start_date) and
+            (cp.deleted_flag = 0) "
+
+      :case_reporters
+         "select
+            a.enterprise_id,
+            a.case_id,
+            a.seq_num,
+            a.media_id,
+            a.occupation_id,
+            a.hcp_flag,
+            a.primary_contact,
+            a.corr_contact,
+            a.reporter_type,
+            a.intermediary_id,
+            a.rpt_sent,
+            a.sort_id,
+            a.confidential,
+            a.country_id,
+            a.reporter_id,
+            a.institution,
+            a.institution_id,
+            b.version_num,
+            b.effective_start_date,
+            b.effective_end_date
+          from
+            rm_case_reporters as a,
+            case_version_table as b
+          where
+            (a.case_id = b.case_id) and
+            (a.enterprise_id = b.enterprise_id) and
+            (a.deleted_flag = 0) and
+            (a.effective_start_date <= b.effective_start_date) and
+            (a.effective_end_date > b.effective_start_date) "
+
+      :case_study
+         "select
+            a.case_id,
+            a.blind_name,
+            a.center_id,
+            a.classification_id,
+            a.code_broken,
+            a.dev_phase_id,
+            a.other_id,
+            a.study_desc,
+            a.study_key,
+            a.study_num,
+            b.version_num,
+            b.effective_start_date,
+            b.effective_end_date,
+            a.enterprise_id
+          from
+            rm_case_study as a,
+            case_version_table as b
+          where
+            (a.case_id = b.case_id) and
+            (a.enterprise_id = b.enterprise_id) and
+            (a.deleted_flag = 0) and
+            (a.effective_start_date <= b.effective_start_date) and
+            (a.effective_end_date > b.effective_start_date) "
+
+      :lm_case_classification
+         "select * from rm_lm_case_classification "
+
+      :lm_causality
+         "select * from rm_lm_causality "
+
+      :lm_countries
+         "select * from rm_lm_countries "
+
+      :lm_product
+         "select
+            enterprise_id,
+            product_id,
+            prod_name,
+            family_id,
+            formulation_id,
+            manufacturer_id,
+            concentration,
+            conc_unit_id,
+            indication_id,
+            code_dict,
+            indication_text,
+            intl_birth_date,
+            model_no,
+            drug_code,
+            prod_generic_name,
+            ind_llt_code,
+            ind_llt,
+            ind_hlt_code,
+            ind_hlt,
+            ind_hlgt_code,
+            ind_hlgt,
+            ind_soc_code,
+            ind_soc,
+            ind_syn_code,
+            ind_code_status,
+            prod_name_abbrv,
+            ind_coded,
+            ind_reptd
+          from
+            rm_lm_product
+          where
+            deleted is null "
+
+      :lm_product_family
+         "select
+            t.enterprise_id,
+            t.family_id,
+            t.name,
+            t.primary_view,
+            t.product_group_id,
+            t.deleted,
+            t.name_j
+          from
+            rm_lm_product_family t"
+
+      :lm_report_type
+         "select * from rm_lm_report_type "
+    } ))

 (defn -main []
   (let [pva-tables-kw (keys pva-trans) ]
@@ -486,7 +486,7 @@
       (newline) (newline)

       (doseq [table-kw pva-tables-kw]
-        (spyx table-kw)
+      ; (spyx table-kw)
         (let [
           table-name        (name table-kw)
           pva-fullname      (format "pva.%s" table-name)
@@ -498,8 +498,10 @@
           ; example create-cmd =
           ;   "create table pva.lm_report_type as
           ;      (select * from rm_lm_report_type); "
-          (spyx create-cmd)
+        ; (spyx create-cmd)
           (jdbc/execute! db-conn [create-cmd] )
-        ))
-    )))
-
+        ))))
+  (newline)
+  (println "-----------------------------------------------------------------------------")
+  (println "complete"))
+


Cleaning up doc strings.

Cleaning up doc strings.

--- src/org/libraryweasel/ligature/core.clj
+++ src/org/libraryweasel/ligature/core.clj
@@ -38,13 +38,13 @@

 (defprotocol ReadTx
   (all-statements [this]
-    "Accepts nothing but returns a channel of all Statements in the Collection.")
+    "Accepts nothing but returns a seq of all Statements in the Collection.")
   (match-statements [this pattern]
-    "Is passed a pattern and returns a channel with all matching Statements.")
+    "Is passed a pattern and returns a seq with all matching Statements.")
   (all-rules [this]
-    "Accepts nothing but returns a channel of all Rules in the Collection.")
+    "Accepts nothing but returns a seq of all Rules in the Collection.")
   (match-rules [this pattern]
-    "Is passed a pattern and returns a channel with all matching rules.")
+    "Is passed a pattern and returns a seq with all matching rules.")
   (cancel [this]
     "Cancels this transaction.")
   (sparql-query [this query]
@@ -56,7 +56,7 @@

 (defprotocol WriteTx
   (new-identifier [this]
-    "Returns channel with a unique, new identifier in the form _:NUMBER")
+    "Returns a new, unique to this collection identifier in the form _:NUMBER")
   (add-statement [this statement]
     "Accepts a statement tuple")
   (remove-statement [this statement]


fix to the point that framework messages work

--- src/riak_mesos/scheduler.clj
+++ src/riak_mesos/scheduler.clj
@@ -28,7 +28,8 @@
                                 (println "sent")
                                 (clj-mesos.scheduler/send-framework-message driver executor slave (.getBytes (pr-str command))))))
                           (when (= :task-running (:state status))
-                            (swap! active-executors conj (read-string (String. (:data status) "UTF-8"))))
+                            (swap! active-executors conj {:executor-id (read-string (String. (:data status) "UTF-8"))
+                                                          :slave-id (:slave-id status)}))
                           (let [id-from-status (comp #(Integer/parseInt %) str last :task-id)]
                             (cond
                               (= (:task-state status) :task-staging) nil
@@ -36,8 +37,8 @@
                               (= (:task-state status) :task-running) nil
                               :else
                               (do
-                                (swap! running disj (id-from-status status))
-                                (swap! pending conj (id-from-status status))))))
+                                #_(swap! running disj (id-from-status status))
+                              #_(swap! pending conj (id-from-status status))))))
                         (catch Exception e
                           (.printStackTrace e)))))
       (resourceOffers [driver offers]
@@ -59,7 +60,7 @@
                                     (clj-mesos.scheduler/launch-tasks
                                       driver
                                       (:id offer)
-                                      [{:name "Riak"
+                                      (doto [{:name "Riak"
                                         :task-id (str "riak-node-" node)
                                         :slave-id (:slave-id offer)
                                         :resources {:cpus 1.0
@@ -76,7 +77,7 @@
                                                                           :host-path "/var/log/riak-executor"
                                                                           :mode :rw} ]}
                                                    :command {:shell false}}
-                                        }]))
+                                        }] (println "launch-exec-info"))))
                                 (clj-mesos.scheduler/decline-offer driver (:id offer))))
                             (catch Exception e
                               (.printStackTrace e)))))))))


Add a substitution map to the web.clj ns, for lack of any cleverer ideas for now

--- src/doctopus/web.clj
+++ src/doctopus/web.clj
@@ -46,8 +46,14 @@
       (ring-response/response)
       (ring-response/content-type "text/html")))

+;; A map from string-to-look-for to value-to-sub-with, representing global
+;; configuration values that Heads will use to parse commands for their
+;; tentacles. Currently hard-coded; could eventually be moved to config files if
+;; we can every think of a reason why we'd want that.
+(def substitutions {"$URL_ROOT"  (:ip (server-config))})
+
 ;; Let's start bootstrapping!
-(def doctopus (bootstrap-heads (Doctopus. (server-config))))
+(def doctopus (bootstrap-heads (Doctopus. (server-config) substitutions)))

 (defn serve-index
   [_]


Save viewport as part of world

Save viewport as part of world

--- src/robinson/worldgen.clj
+++ src/robinson/worldgen.clj
@@ -204,6 +204,8 @@
        tongue-identifiable     (set (take (/ (count poisoned-fruit) 2) (dg/shuffle poisoned-fruit)))]

   {:seed seed
+   :viewport {
+     :pos {:x 0 :y 0}}
    :places {:0_0 place-0}
             ;:1 (init-place-1)}
    :current-place :0_0


Fix save-frame (allowing string file-matcher arg) and add stroke-cap modes for lines. Also add docstrings for both fns

--- src/rosado/processing.clj
+++ src/rosado/processing.clj
@@ -981,8 +981,18 @@
 ;; $$saveFile

 (defn save-frame
+  "Saves an image identical to the current display window as a file. May be
+  called multple times - each file saved will have a unique name. Name and image
+  formate may be modified by passing a string parameter of the form
+  \"foo-####.ext\" where foo- can be any arbitrary string, #### will be replaced
+  with the current frame id and .ext is one of .tiff, .targa, .png, .jpeg or
+  .jpg
+
+  Examples:
+  (save-frame)
+  (save-frame \"pretty-pic-####.jpg\")"
   ([] (.saveFrame *applet*))
-  ([what] (.saveFrame *applet*)))
+  ([name] (.saveFrame *applet* (str name))))

 ;; $$savePath
 ;; $$saveStream
@@ -1081,6 +1091,18 @@
 ;; $$stop
 ;; $$str

+(def ^{:private true}
+  stroke-cap-map {:square SQUARE
+                  :round ROUND
+                  :project PROJECT
+                  :model MODEL})
+
+(defn- resolve-stroke-cap-mode
+  [mode]
+  (if (keyword? mode)
+    (get stroke-cap-map mode)
+    mode))
+
 (defn stroke-float
   "Sets the color used to draw lines and borders around shapes."
   ([gray] (.stroke *applet* (float gray)))
@@ -1097,7 +1119,13 @@
        :doc (:doc (meta #'stroke-float))}
   stroke stroke-float)

-(defn stroke-cap [cap] (.strokeCap *applet* (int cap)))
+(defn stroke-cap
+  "Sets the style for rendering line endings. These ends are either squared,
+  extended, or rounded and specified with the corresponding parameters :square,
+  :project, and :round. The default cap is :round. "
+  [cap-mode]
+  (let [cap-mode (resolve-stroke-cap-mode cap-mode)]
+    (.strokeCap *applet* (int cap-mode))))

 (defn stroke-join [jn] (.strokeJoin *applet* (int jn)))


guard against js/location use for node

guard against js/location use for node

fixes #401

--- support/src/figwheel/client.cljs
+++ support/src/figwheel/client.cljs
@@ -323,11 +323,13 @@
     config))

 (defn fill-url-template [config]
-  (update-in config [:websocket-url]
+  (if (utils/html-env?)
+      (update-in config [:websocket-url]
              (fn [x]
                (-> x
                    (string/replace "[[client-hostname]]" js/location.hostname)
-                   (string/replace "[[client-port]]" js/location.port)))))
+                   (string/replace "[[client-port]]" js/location.port))))
+      config))

 (defn base-plugins [system-options]
   (let [base {:enforce-project-plugin enforce-project-plugin


fix defn arg lists, fix env

fix defn arg lists, fix env

--- src/semitone/core.clj
+++ src/semitone/core.clj
@@ -9,6 +9,7 @@
 ;;    - get a unique set of channels from the intersecting notes
 ;;    - choose to play on the next available channel on the channel list
 ;;    - if no channels are available, play on the next channel/least used channel
+;;   fix envelopes
 ;;   :time-signature [4 4]
 ;;   add shortcuts for intervals, chords, key signatures, dynamics
 ;;   DAW recording interface for capturing param values / performances
@@ -34,21 +35,15 @@
 (defn ratio [value]
   (clojure.lang.Numbers/toRatio value))

-(defn env [num-points values & args]
-  (let [args (if (empty? args)
-               (if (= 2 (count values)) '(:linear) '(:cubic))
-               args)
-        interp (apply interpolate-parametric values args)
+(defn env [num-points values & [type options]]
+  (let [values (vec values)
+        type (or type (if (= 2 (count values)) :linear :cubic))
+        interp (apply interpolate-parametric values type :range [0 (- num-points 1)] options)
         fix-type (cond
                    (every? ratio? values) ratio
                    (every? integer? values) int
-                   :else double)
-        values (if (= 2 (count values))
-                 (list (first values)
-                       (fix-type (/ (+ (first values) (last values)) 2))
-                       (last values))
-                 values)]
-    (map #(fix-type (interp %)) (concat (take (- num-points 1) (range 0.0 1.0 (/ 1.0 num-points))) [1.0]))))
+                   :else double)]
+    (map #(fix-type (interp %)) (range num-points))))

 (defn vec-rest [coll]
   (if (vector? coll)
@@ -277,12 +272,12 @@
 (def ^:dynamic *seq* (Sequence. Sequence/PPQ 256))
 (def ^:dynamic *synth* (MidiSystem/getSynthesizer))

-(defn load-soundfont [soundfont & [synth]]
+(defn load-soundfont [soundfont & [synth _]]
   (let [synth (or synth *synth*)
         soundbank (SF2Soundbank. (java.io.FileInputStream. soundfont))]
     (.loadAllInstruments synth soundbank)))

-(defn make-sequencer [& [sequence synth]]
+(defn make-sequencer [& [sequence synth _]]
   (let [sequence (or sequence *seq*)
         synth (or synth *synth*)
         sequencer (MidiSystem/getSequencer false)]
@@ -300,7 +295,7 @@

 (def ^:dynamic *sequencer* (make-sequencer *seq* *synth*))

-(defn compose [notes & [sequencer state]]
+(defn compose [notes & [sequencer state _]]
   (let [sequencer (or sequencer *sequencer*)
         notes (if (or (vector? notes) (seq? notes)) notes (list notes))
         state (merge {:sequencer sequencer
@@ -414,7 +409,7 @@
                                      :midi-message nil})))
         state))))

-(defn play [& [notes sequencer state]]
+(defn play [& [notes sequencer state _]]
   (let [sequencer (or sequencer *sequencer*)
         state (compose (or notes '()) sequencer state)]
     (when (nil? notes)
@@ -422,7 +417,7 @@
     (.start sequencer)
     (while (.isRunning sequencer) (Thread/sleep 100))))

-(defn clear [& [sequencer]]
+(defn clear [& [sequencer _]]
   (let [sequencer (or sequencer *sequencer*)
         sequence (.getSequence sequencer)]
     (doseq [track (.getTracks sequence)]


Article and paragraph component

Article and paragraph component

--- src/stratus/core.cljs
+++ src/stratus/core.cljs
@@ -9,6 +9,16 @@
   (render [this]
           (dom/h1 nil (:text data))))

-(om/root widget {:text "Hello, world!"}
+(defcomponent paragraph [data owner]
+  (render [this]
+          (dom/p nil (:text data))))
+
+(defcomponent article [data owner]
+  (render [this]
+          (dom/div nil
+           (om/build-all paragraph
+                         (repeatedly (:number data) (constantly {:text "Hello, world!"}))))))
+
+(om/root article {:number 5}
          {:target (. js/document (getElementById "stratus"))})


CMR-3096: Index two-d-coordinate-system using UMM-SPEC

--- indexer-app/src/cmr/indexer/data/concepts/collection.clj
+++ indexer-app/src/cmr/indexer/data/concepts/collection.clj
@@ -185,7 +185,8 @@
                                  (map str/trim))
         project-long-names (->> (keep :long-name (:projects collection))
                                 (map str/trim))
-        two-d-coord-names (map :name (:two-d-coordinate-systems collection))
+        two-d-coord-names (map :TilingIdentificationSystemName
+                               (:TilingIdentificationSystems umm-spec-collection))
         archive-centers (map #(org/data-center-short-name->elastic-doc gcmd-keywords-map %)
                              (map str/trim
                                   (org/extract-data-center-names collection :archive-center)))


Fixing build

Fixing build

--- src/helda/schema.clj
+++ src/helda/schema.clj
@@ -27,8 +27,8 @@

 (s/defschema Action{
   :source-model s/Str
-  (s/optional-key :request-ctx ActionCtxMeta)
-  (s/optional-key :response-ctx ActionCtxMeta)
+  (s/optional-key :request-ctx) ActionCtxMeta
+  (s/optional-key :response-ctx) ActionCtxMeta
   :module-id s/Keyword
   })


debugger: added highlighting of parent signals

--- examples/_common/middleware/devtools.cljs
+++ examples/_common/middleware/devtools.cljs
@@ -22,8 +22,11 @@
 (def Schema
   {::debugger {:initial-model              {schema/Any schema/Any}

-               :signal-events              [{:id schema/Int :signal schema/Any}]
+               :signal-events              [{:id        schema/Int
+                                             :parent-id (schema/maybe schema/Int)
+                                             :signal    schema/Any}]
                :next-signal-id             schema/Int
+               :highlighted-signal-id      (schema/maybe schema/Int)

                :action-events              [{:id        schema/Int
                                              :signal-id schema/Int
@@ -46,6 +49,7 @@

                             :signal-events              nil
                             :next-signal-id             0
+                            :highlighted-signal-id      nil

                             :action-events              nil
                             :next-action-id             0
@@ -56,12 +60,13 @@
                             :toggle-visibility-shortcut toggle-visibility-shortcut}))

 (defn -signal-event
-  [id signal]
-  {:id     id
-   :signal signal})
+  [id parent-id signal]
+  {:id        id
+   :parent-id parent-id
+   :signal    signal})

 (defn -action-event
-  [signal-id id action result]
+  [id signal-id action result]
   {:id        id
    :signal-id signal-id
    :enabled?  true
@@ -110,14 +115,16 @@
   (let [unlisten-shortcuts (atom nil)]
     (fn control
       [model signal dispatch-signal dispatch-action]
-      (letfn [(record-and-dispatch-to-app [signal]
-                (let [signal-event (-signal-event (-> @model ::debugger :next-signal-id) signal)]
+      (letfn [(record-and-dispatch-to-app [signal parent-signal-id]
+                (let [signal-event (-signal-event (-> @model ::debugger :next-signal-id) parent-signal-id signal)
+                      intercepted-dispatch-signal #(dispatch-signal [::on-app-signal (:id signal-event) %])
+                      intercepted-dispatch-action #(dispatch-action [::app-action (:id signal-event) %])]
                   (dispatch-action [::record-signal-event signal-event])
-                  (app-control model signal dispatch-signal #(dispatch-action [::app-action (:id signal-event) %]))))]
+                  (app-control model signal intercepted-dispatch-signal intercepted-dispatch-action)))]
         (match signal
                :on-start
                (do
-                 (record-and-dispatch-to-app :on-start)
+                 (record-and-dispatch-to-app :on-start nil)

                  (let [shortcut-handler (KeyboardShortcutHandler. js/document)
                        key (goog.events/listen shortcut-handler
@@ -131,7 +138,7 @@
                (do
                  #(@unlisten-shortcuts)

-                 (record-and-dispatch-to-app :on-stop))
+                 (record-and-dispatch-to-app :on-stop nil))

                ::on-did-load-from-storage
                (dispatch-action ::replay)
@@ -172,8 +179,16 @@
                [::on-load content]
                (dispatch-action [::load (cljs.reader/read-string content)])

+               [::on-highlight-signal id]
+               (dispatch-action [::highlight-signal id])
+
+               ; app signal coming from specific signal
+               [::on-app-signal parent-id s]
+               (record-and-dispatch-to-app s parent-id)
+
+               ; bare app signal
                :else
-               (record-and-dispatch-to-app signal))))))
+               (record-and-dispatch-to-app signal nil))))))

 ;;;;;;;;;;;;;;;;;;;;;;;; Reconcile
 (defn -orphaned-signal?
@@ -239,13 +254,16 @@
            [::load new-model]
            new-model

+           [::highlight-signal id]
+           (assoc-in model [::debugger :highlighted-signal-id] id)
+
            ; app action coming from specific signal
            [::app-action signal-id a]
            (if (-find-signal model signal-id)
              (as-> model m
                    (app-reconcile m a)
-                   (update-in m [::debugger :action-events] concat [(-action-event signal-id
-                                                                                (-> m ::debugger :next-action-id)
+                   (update-in m [::debugger :action-events] concat [(-action-event (-> m ::debugger :next-action-id)
+                                                                                signal-id
                                                                                a
                                                                                (dissoc m ::debugger))])
                    (update-in m [::debugger :next-action-id] inc))
@@ -255,7 +273,7 @@

            ; for bare app actions (e.g. when originating signal was cleared) create an "unknown signal" event
            :else
-           (let [unknown-signal-event (-signal-event (-> model ::debugger :next-signal-id) ::unknown-signal)]
+           (let [unknown-signal-event (-signal-event (-> model ::debugger :next-signal-id) nil ::unknown-signal)]
              (-> model
                  (update-in [::debugger :signal-events] concat [unknown-signal-event])
                  (update-in [::debugger :next-signal-id] inc)
@@ -265,7 +283,7 @@
 (defn -view-model
   [model]
   (mvsa/track-keys (reaction (::debugger @model))
-                   [:initial-model :persist? :visible? :toggle-visibility-shortcut :signal-events :action-events]))
+                   [:initial-model :persist? :visible? :toggle-visibility-shortcut :signal-events :action-events :highlighted-signal-id]))

 ;;;;;;;;;;;;;;;;;;;;;;;; View
 (def -menu-button-style {:margin        "5px 3px"
@@ -344,26 +362,29 @@
          "model"])])])

 (defn -signal-view
-  [signal-id signal dispatch]
-  [:div {:style    {:margin-top       8
-                    :padding-left     4
-                    :cursor           "pointer"
-                    :background-color "rgb(60, 70, 80)"}
-         :title    "Click to enable/disable all actions dispatched from this signal"
-         :on-click #(dispatch [::on-toggle-signal signal-id])}
+  [{:keys [id parent-id signal] :as _signal-event} highlighted? dispatch]
+  [:div {:style         {:margin-top       8
+                         :padding-left     4
+                         :cursor           "pointer"
+                         :background-color (if highlighted? "rgb(50, 150, 60)" "rgb(60, 70, 80)")}
+         :title         "Click to enable/disable all actions dispatched from this signal"
+         :on-click      #(dispatch [::on-toggle-signal id])
+         :on-mouse-over #(dispatch [::on-highlight-signal parent-id])
+         :on-mouse-out  #(dispatch [::on-highlight-signal nil])}
+   (when (not (nil? parent-id)) "△ ")
    (if (coll? signal)
      [:span (pr-str (first signal)) " " (clojure.string/join " " (map pr-str (rest signal)))]
      (pr-str signal))])

 (defn -signals-view
-  [signal-events action-events dispatch]
+  [signal-events action-events highlighted-signal-id dispatch]
   [:div
    (doall
-     (for [{:keys [id signal]} signal-events]
-       ^{:key id}
+     (for [signal-event signal-events]
+       ^{:key (:id signal-event)}
        [:div
-        [-signal-view id signal dispatch]
-        [-actions-view action-events id dispatch]]))])
+        [-signal-view signal-event (= (:id signal-event) highlighted-signal-id) dispatch]
+        [-actions-view action-events (:id signal-event) dispatch]]))])

 (defn -initial-model-view
   [initial-model]
@@ -403,7 +424,8 @@
         body))

 (defn -view
-  [{:keys [visible? toggle-visibility-shortcut persist? initial-model signal-events action-events] :as _view-model} dispatch]
+  [{:keys [visible? toggle-visibility-shortcut persist? initial-model signal-events action-events :highlighted-signal-id]}
+   dispatch]
   [-overlay
    [-resizable-div {:style {:display          (if @visible? "block" "none") ; using CSS instead of React in order to persist resized frame on toggling visibility
                             :left             "70%"
@@ -429,7 +451,7 @@
      [:hr]
      [-initial-model-view @initial-model]
      [:hr]
-     [-signals-view @signal-events @action-events dispatch]]]])
+     [-signals-view @signal-events @action-events @highlighted-signal-id dispatch]]]])

 ;;;;;;;;;;;;;;;;;;;;;;;; Middleware
 (defn -wrap-load-from-storage


added sample data

added sample data


Preparing to generate initial map.

Preparing to generate initial map.

--- src/wanderlust/svg_draft.clj
+++ src/wanderlust/svg_draft.clj
@@ -8,11 +8,11 @@

 (def ^:private ids (atom {}))

-(defn reset-ids []
+(defn reset-ids! []
   (reset! ids {}))
-(defn gen-id
+(defn gen-id!
   ([prefix]
-    (gen-id prefix "-"))
+    (gen-id! prefix "-"))
   ([prefix div]
    (format "%s%s%05d"
            prefix div
@@ -40,7 +40,7 @@
             height 500
             location-step 50
             location-deviation 35}}]
-   (reset-ids)
+   (reset-ids!)
    (let [locations (locations-grid width height location-step location-deviation) ]
      [:dali/page {:width width :height height}
       (s/css "circle.location {stroke: yellow; fill: red;}")
@@ -55,9 +55,26 @@
        [:circle {:stroke :black :stroke-width 1 :fill :indigo} [0 0] 1]]
       (into
         [:g {:id "locations" :inkscape:groupmode "layer" :inkscape:label "locations"}]
-        (map (fn [coord] [:circle {:id (gen-id "location") :class "location"} coord 3]) locations))
+        (map (fn [coord] [:circle {:id (gen-id! "location") :class "location"} coord 3]) locations))
       [:g {:id "labels" :inkscape:groupmode "layer" :inkscape:label "labels"}
        [:circle {:stroke :black :stroke-width 1 :fill :indigo} [0 0] 1]]])))
+
+
+(defn generate-chart
+  ([] (generate-chart {} {}))
+  ([map-params gen-params]
+   (reset-ids!)
+   {:name "Terra Incognita"
+    :desc "HC SVNT DRACONES"
+    :width  1000
+    :height 500
+    :gen-params {
+      :location-step 50
+      :location-deviation 35}
+    :locations {}
+    :pathways {}
+    :terrain {}
+    }))

 (defn svg-draft->chart [svg-draft]
   (let [svg-doc (xml->doc svg-draft)]


update user grouper

update user grouper

--- src/wiki_user_group/core.clj
+++ src/wiki_user_group/core.clj
@@ -39,7 +39,9 @@
     (.contains role-list-3 role-str)
     3
     :else
-    role-str))
+    0))
+;   role-str))
+

 (defn read-to-map [users m]
   (if (seq users)


Add leave game support on the API

Add leave game support on the API

Everytime a user leaves a game we want to remove that channel
from the game room so they no longer receive messages from that
game.

--- src/wombats/sockets/game.clj
+++ src/wombats/sockets/game.clj
@@ -11,16 +11,38 @@
             [io.pedestal.http.jetty.websockets :as ws]))

 (def ^:private game-rooms (atom {}))
-
 (def ^:private connections (atom {}))
+
+(defn- remove-chan-form-room
+  [game-id chan-id]
+  (swap! game-rooms update-in [game-id :players] dissoc chan-id))
+
+(defn- cleanup-closed-connections
+  []
+  (doseq [[chan-id {:keys [session]}] @connections]
+    (let [channel-open? (.isOpen session)]
+      (when-not channel-open?
+        ;; Remove channel from game rooms
+        (map (fn [game-id {players :players}]
+               (let [contains-connection? (chan-id players)]
+                 (when contains-connection?
+                   (remove-chan-form-room game-id chan-id))))
+             @game-rooms)
+        ;; Remove channel from connections
+        (swap! connections dissoc chan-id)))))
+
+(defn- cleanup-empty-games
+  []
+  (doseq [[game-id {:keys [players]}] @game-rooms]
+    (let [game-empty? (= (count players) 0)]
+      (when game-empty?
+        (swap! game-rooms dissoc game-id)))))

 (defn clean-connections
   "Removes all closed connections from state"
   [time]
-  (doseq [[chan-id {:keys [session]}] @connections]
-    (let [channel-open? (.isOpen session)]
-      (when-not channel-open?
-        (swap! connections dissoc chan-id)))))
+  (cleanup-closed-connections)
+  (cleanup-empty-games))

 (defn connection-clean-err
   "If the scheduler fails this will be called
@@ -52,6 +74,8 @@

   ;; Print connections
   (clojure.pprint/pprint @connections)
+
+  (clojure.pprint/pprint @game-rooms)

   ;; Remove all closed connections
   (clean-connections 0)
@@ -138,6 +162,12 @@
              assoc-in
              [game-id :players chan-id]
              (assoc socket-user :color (:player/color player))))))
+
+(defn- leave-game
+  [_]
+  (fn [{:keys [chan-id] :as socket-user}
+      {:keys [game-id]}]
+    (remove-chan-form-room game-id chan-id)))

 (defn- broadcast-game-message
   [game-id formatted-message]
@@ -202,6 +232,7 @@
   {:keep-alive keep-alive
    :handshake (handshake datomic)
    :join-game (join-game datomic)
+   :leave-game (leave-game datomic)
    :authenticate-user (authenticate-user datomic)
    :chat-message (chat-message datomic)})


url and title macroses added

url and title macroses added

--- src/webdriver/dsl.clj
+++ src/webdriver/dsl.clj
@@ -87,11 +87,23 @@
 (defn go-url [url]
   (api/go-url *server* *session* url))

+;;
+;; url and title
+;;
+
 (defn get-title []
   (api/get-title *server* *session*))

 (defn get-url []
   (api/get-url *server* *session*))
+
+(defmacro with-title [name & body]
+  `(let [~name (get-title)]
+     ~@body))
+
+(defmacro with-url [name & body]
+  `(let [~name (get-url)]
+     ~@body))

 ;;
 ;; elements


tuned with exception printing

tuned with exception printing

--- src/ontrail/core.clj
+++ src/ontrail/core.clj
@@ -28,7 +28,7 @@
       :body (json-str ~data)}
      (catch Exception exception#
        (.error logger (str exception#))
-       (stacktrace/print-stack-trace exception#)
+       (stacktrace/print-stack-trace exception# 100)
        {:status 400
         :headers {"Content-Type" "application/tex"}
         :body (str exception#)})))


referer controls login return url

referer controls login return url

--- src/ontrail/core.clj
+++ src/ontrail/core.clj
@@ -168,19 +168,28 @@
       (json-response {:success true})
       (json-response {:message "wrong-password"} 400)))

-  (POST "/rest/v2/login" [username password location]
-        (if (authenticate username password)
-          (let [case-user (user/get-case-user username)
-                authToken (auth-token case-user)
-                authUser (:username (user/get-case-user username))]
+  (POST "/rest/v2/login" {params :params headers :headers}
+        (.info logger (str headers))
+        (let [username (:username params)
+              password (:password params)
+              new-location (if-let [referer (headers "referer")] referer "/m/index.html")]
+          (if (authenticate username password)
+            (let [case-user (user/get-case-user username)
+                  authToken (auth-token case-user)
+                  authUser (:username (user/get-case-user username))]
+              {:status 301
+               :headers {"Content-Type" "text/html"
+                         "Location" new-location}
+               :cookies {"authToken" {:value authToken}
+                         "authUser" {:value authUser}}
+               :body ""
+               })
             {:status 301
              :headers {"Content-Type" "text/html"
-                       "Location" location}
-             :cookies {"authToken" {:value authToken}
-                       "authUser" {:value authUser}}
+                       "Location" (str new-location "?status=login_failed")
+                       "X-Ontrail-Status" "login-failed"}
              :body ""
-             })
-          (json-response {:error "Authentication failed"} 401)))
+             })))

   (POST "/rest/v1/login" [username password]
         (if (authenticate username password)


Remove lingering example

Remove lingering example

--- src/shokunin/fizzbuzz.clj
+++ src/shokunin/fizzbuzz.clj
@@ -3,6 +3,3 @@
 (def fizz-buzz (let [fizzer (cycle [nil nil "fizz"])
                      buzzer (cycle [nil nil nil nil "buzz"])]
                  (map str fizzer buzzer)))
-
-(take 15 fizz-buzz)
-


Rework util functions and improve docs.

Rework util functions and improve docs.

--- src/re_com/util.cljs
+++ src/re_com/util.cljs
@@ -2,38 +2,43 @@
   (:require  [clojure.string :as string]))

 (defn fmap
-  "I return a new version of 'm' in which f has been applied to each value.
+  "Takes a fucntion 'f' amd a map 'm'.  Applies 'f' to each value in 'm' and returns.
    (fmap  inc  {:a 4  :b 2})   =>   {:a 5  :b 3}"
   [f m]
-  ;;TODO Now a duplicate of day8core/core_utils.cljs in mwireader project. We need common core util libs !
   (into {} (for [[k val] m] [k (f val)])))

-(defn deref-or-value [val-or-atom]
+
+(defn deref-or-value
+  [val-or-atom]
   (if (satisfies? IDeref val-or-atom) @val-or-atom val-or-atom))
+

 (defn get-element-by-id
   [id]
   (.getElementById js/document id))

+
 (defn pad-zero
-  "If subject-str zero pad subject-str from left up to max-chars."
-  [subject-str max-chars]
-  (if (< (count subject-str) max-chars)
-    (apply str (take-last max-chars (concat (repeat max-chars \0) subject-str)))
-    subject-str))
+  "Left pad a string 's' with '0', until 's' has length 'len'. If 's' is already len or greater, return 's'"
+  [s len]
+  (if (< (count s) len)
+    (apply str (take-last len (concat (repeat len \0) s)))
+    s))
+

 (defn pad-zero-number
-  "If subject-num zero pad subject-str from left up to max-chars."
-  [subject-num max-chars]
-  (pad-zero (str subject-num) max-chars))
+  "return 'num' as a string of 'len' characters, left padding with '0' as necessary."
+  [num len]
+  (pad-zero (str num) len))

-(defn find-map-index
-  "In a vector of maps (where each map has an :id), return the index of the first map containing the id parameter.
+
+(defn find-map-index    ;;  TODO: rename this  'id-position'
+  "Takes a vector of maps 'v'. Returns the postion of the first item in 'v' whose :id matches 'id'.
    Returns nil if id not found."
-  [choices id]
-  (let [index-fn (fn [index item] (when (= (:id item) id) index))
-        index-of-id (first (keep-indexed index-fn choices))]
-    index-of-id))
+  [v id]
+  (let [index-fn (fn [index item] (when (= (:id item) id) index))]
+    (first (keep-indexed index-fn v))))
+

 ;; ----------------------------------------------------------------------------
 ;; G O L D E N  R A T I O  https://en.wikipedia.org/wiki/Golden_ratio
@@ -43,6 +48,7 @@
   [b-segment]
   (let [Phi 1.618]
     (/ b-segment Phi)))
+

 (defn golden-ratio-b
   "Answer the B segment using golden ratio"
@@ -55,8 +61,12 @@
 ;; ----------------------------------------------------------------------------

 (defn remove-nth
-  [vect index]
-  (vec (for [i (range (count vect)) :when (not= i index)] (get vect i))))
+  "Removes the item at position n from a vector v, returning a shrunk vector"
+  [v n]
+  (vec
+    (concat
+      (subvec v 0 n) (subvec v (inc n) (count v)))))
+

 (defn insert-nth
   [vect index item]


lein-release plugin: bumped version from 0.2.2 to 0.2.3-SNAPSHOT for next development cycle

--- material/project.clj
+++ material/project.clj
@@ -1,4 +1,4 @@
-(defproject re-view/material "0.2.2"
+(defproject re-view/material "0.2.3-SNAPSHOT"

   :description "Material design components in re-view"


No need to refer draw fn

No need to refer draw fn

--- src-cljs/defpi/onload.cljs
+++ src-cljs/defpi/onload.cljs
@@ -1,6 +1,6 @@
 (ns defpi.onload
   (:require [defpi.ws :refer [add-ws-handlers]]
-            [defpi.canvas :refer [draw]]))
+            [defpi.canvas]))

 (set! (.-onload js/window)
       (fn []


format fix

format fix

--- test/com/wsscode/pathom/system_test.clj
+++ test/com/wsscode/pathom/system_test.clj
@@ -24,11 +24,11 @@

 (defn valid-queries-props []
   (prop/for-all [query (eql/make-gen
-                          {::eql/gen-params
-                           (fn [_]
-                             (gen/map gen/keyword-ns gen/simple-type-printable))}
-                          ::eql/gen-query)]
-                 (s/valid? ::eql/query query)))
+                         {::eql/gen-params
+                          (fn [_]
+                            (gen/map gen/keyword-ns gen/simple-type-printable))}
+                         ::eql/gen-query)]
+    (s/valid? ::eql/query query)))

 (test/defspec generator-makes-valid-queries {:max-size 12 :num-tests 50} (valid-queries-props))

@@ -96,16 +96,16 @@
 (defn parser-test-props [env]
   (prop/for-all [{:keys [query errors? plugins]} (->> (base-gen)
                                                       (gen/fmap #(update % :query p/remove-query-wildcard)))]
-                 (let [plugins       (mapv (comp deref resolve) plugins)
-                       parser        (p/parser {::p/plugins plugins
-                                                :mutate     pt/mutate-fn})
-
-                       async-parser  (p/async-parser {::p/plugins plugins
-                                                      :mutate     pt/mutate-fn})
-
-                       {:keys [async-reader] :as env} (cond-> env errors? (assoc ::pt/throw-errors? true))]
-                   (= (catch-run-parser parser env query)
-                      (catch-run-parser (comp <!! async-parser) (assoc env ::p/reader async-reader) query)))))
+    (let [plugins       (mapv (comp deref resolve) plugins)
+          parser        (p/parser {::p/plugins plugins
+                                   :mutate     pt/mutate-fn})
+
+          async-parser  (p/async-parser {::p/plugins plugins
+                                         :mutate     pt/mutate-fn})
+
+          {:keys [async-reader] :as env} (cond-> env errors? (assoc ::pt/throw-errors? true))]
+      (= (catch-run-parser parser env query)
+         (catch-run-parser (comp <!! async-parser) (assoc env ::p/reader async-reader) query)))))

 (test/defspec parser-system {:max-size 12 :num-tests 100} (parser-test-props pct/parser-env))

@@ -117,23 +117,23 @@
                                                                  :max-elements 50})
                             4)]
     (prop/for-all [{:keys [index query]}
-                    (gen/let [index (eql/make-gen (pcg/gen-connect-index props)
-                                                  ::pcg/gen-index)
-                              query (->> (eql/make-gen (pcg/gen-connect-query {::pc/indexes index})
-                                                       ::eql/gen-query)
-                                         (gen/fmap p/remove-query-wildcard))]
-                      {:index index :query query})]
-                   (let [plugins      [p/error-handler-plugin]
-                         parser       (p/parser {::p/plugins plugins})
-
-                         async-parser (p/async-parser {::p/plugins plugins})
-
-                         env          (assoc env ::p/reader [p/map-reader pc/all-readers]
-                                        ::pc/indexes index
-                                        ::pc/resolver-dispatch pct/resolve-fn)]
-                     (= (parser env query)
-                        (<!! (async-parser (assoc env ::p/reader [p/map-reader pc/all-async-readers]
-                                             ::pc/resolver-dispatch pct/async-resolve-fn) query)))))))
+                   (gen/let [index (eql/make-gen (pcg/gen-connect-index props)
+                                                 ::pcg/gen-index)
+                             query (->> (eql/make-gen (pcg/gen-connect-query {::pc/indexes index})
+                                                      ::eql/gen-query)
+                                        (gen/fmap p/remove-query-wildcard))]
+                     {:index index :query query})]
+      (let [plugins      [p/error-handler-plugin]
+            parser       (p/parser {::p/plugins plugins})
+
+            async-parser (p/async-parser {::p/plugins plugins})
+
+            env          (assoc env ::p/reader [p/map-reader pc/all-readers]
+                           ::pc/indexes index
+                           ::pc/resolver-dispatch pct/resolve-fn)]
+        (= (parser env query)
+           (<!! (async-parser (assoc env ::p/reader [p/map-reader pc/all-async-readers]
+                                ::pc/resolver-dispatch pct/async-resolve-fn) query)))))))

 #_
 (test/defspec connect-read {:max-size 10 :num-tests 100} (connect-read-props pct/parser-env))
@@ -146,27 +146,27 @@
                                                                  :max-elements 50})
                             4)]
     (prop/for-all [{:keys [index query]}
-                    (gen/let [index (eql/make-gen (pcg/gen-connect-index props)
-                                                  ::pcg/gen-index)
-                              query (->> (eql/make-gen (pcg/gen-connect-query {::pc/indexes index})
-                                                       ::eql/gen-query)
-                                         (gen/fmap p/remove-query-wildcard))]
-                      {:index index :query query})]
-                   (let [plugins         [p/error-handler-plugin]
-                         parser          (p/parser {::p/plugins plugins})
-                         async-parser    (p/async-parser {::p/plugins plugins})
-                         parallel-parser (p/parallel-parser {::p/plugins plugins})
-
-                         env             (assoc env ::p/reader [p/map-reader pc/all-readers]
-                                           ::pc/indexes index
-                                           ::pc/resolver-dispatch pct/resolve-fn)]
-                     (= (parser (assoc env ::p/reader [p/map-reader pc/reader2 pc/ident-reader]) query)
-
-                        (<!! (async-parser (assoc env ::p/reader [p/map-reader pc/async-reader2 pc/ident-reader]
-                                             ::pc/resolver-dispatch pct/async-resolve-fn) query))
-
-                        (<!! (parallel-parser (assoc env ::p/reader [p/map-reader pc/all-parallel-readers]
-                                                ::pc/resolver-dispatch pct/async-resolve-fn) query)))))))
+                   (gen/let [index (eql/make-gen (pcg/gen-connect-index props)
+                                                 ::pcg/gen-index)
+                             query (->> (eql/make-gen (pcg/gen-connect-query {::pc/indexes index})
+                                                      ::eql/gen-query)
+                                        (gen/fmap p/remove-query-wildcard))]
+                     {:index index :query query})]
+      (let [plugins         [p/error-handler-plugin]
+            parser          (p/parser {::p/plugins plugins})
+            async-parser    (p/async-parser {::p/plugins plugins})
+            parallel-parser (p/parallel-parser {::p/plugins plugins})
+
+            env             (assoc env ::p/reader [p/map-reader pc/all-readers]
+                              ::pc/indexes index
+                              ::pc/resolver-dispatch pct/resolve-fn)]
+        (= (parser (assoc env ::p/reader [p/map-reader pc/reader2 pc/ident-reader]) query)
+
+           (<!! (async-parser (assoc env ::p/reader [p/map-reader pc/async-reader2 pc/ident-reader]
+                                ::pc/resolver-dispatch pct/async-resolve-fn) query))
+
+           (<!! (parallel-parser (assoc env ::p/reader [p/map-reader pc/all-parallel-readers]
+                                   ::pc/resolver-dispatch pct/async-resolve-fn) query)))))))

 #_(test/defspec connect-read-planned {:max-size 10 :num-tests 100} (connect-read-planned-props pct/parser-env))


Name the strobe color effect.

Name the strobe color effect.

--- src/afterglow/examples.clj
+++ src/afterglow/examples.clj
@@ -689,7 +689,7 @@

     (let [color-var {:key :strobe-color :type :color :name "Strobe Color"}]
       (ct/set-cue! (:cue-grid *show*) 7 6
-                   (cues/cue :strobe-color (fn [_] (fx/blank))
+                   (cues/cue :strobe-color (fn [_] (fx/blank "Strobe Color"))
                              :color :purple
                              :color-fn (cues/color-fn-from-cue-var color-var)
                              :variables [color-var])))


Adjust random movement actions

Adjust random movement actions

Sometimes, firingsquad bot would not attack when it had a chance, and
would just do random moves. This was because, if the bot was loosing,
the calculated actions would result on boards that were worst (eg:
-3000) than the default random move generator (-1000).

Changed that default value to something really big.

--- src/obb_rules/ai/common.cljc
+++ src/obb_rules/ai/common.cljc
@@ -147,7 +147,7 @@
   "Returns a collection of possible options that move
   the unit by chance"
   ([game element]
-   (move-options game element -1000 1))
+   (move-options game element -10000000 1))
   ([game element value max-options]
    (let [coordinate (element/element-coordinate element)
          unit (element/element-unit element)


Improper use of backpressure return code meant messages were lost

--- src/onyx/messaging/aeron.clj
+++ src/onyx/messaging/aeron.clj
@@ -253,7 +253,9 @@
         pub ^uk.co.real_logic.aeron.Publication (get-peer-link-pub peer-link :send-pub :send-pub-f-create)
         offer-f (fn [] (.offer pub unsafe-buffer 0 len))
         idle-strategy (:send-idle-strategy messenger)]
-    (while (not (offer-f))
+    ;;; TODO: offer will return a particular code when the publisher is down
+    ;;; we should probably re-restablish the publication in this case
+    (while (neg? (offer-f))
       (.idle ^IdleStrategy idle-strategy 0))))

 (defmethod extensions/internal-ack-messages AeronConnection
@@ -264,7 +266,7 @@
     (doseq [{:keys [id completion-id ack-val]} acks]
       (let [unsafe-buffer (protocol/build-acker-message id completion-id ack-val)
             offer-f (fn [] (.offer pub unsafe-buffer 0 protocol/ack-msg-length))]
-        (while (not (offer-f))
+        (while (neg? (offer-f))
           (.idle ^IdleStrategy idle-strategy 0))))))

 (defmethod extensions/internal-complete-message AeronConnection
@@ -273,7 +275,7 @@
         unsafe-buffer (protocol/build-completion-msg-buf id)
         pub ^uk.co.real_logic.aeron.Publication (get-peer-link-pub peer-link :aux-pub :aux-pub-f-create)
         offer-f (fn [] (.offer pub unsafe-buffer 0 protocol/completion-msg-length))]
-    (while (not (offer-f))
+    (while (neg? (offer-f))
       (.idle ^IdleStrategy idle-strategy 0))))

 (defmethod extensions/internal-retry-message AeronConnection
@@ -282,7 +284,7 @@
         unsafe-buffer (protocol/build-retry-msg-buf id)
         pub ^uk.co.real_logic.aeron.Publication (get-peer-link-pub peer-link :aux-pub :aux-pub-f-create)
         offer-f (fn [] (.offer pub unsafe-buffer 0 protocol/retry-msg-length))]
-    (while (not (offer-f))
+    (while (neg? (offer-f))
       (.idle ^IdleStrategy idle-strategy 0))))

 (defmethod extensions/close-peer-connection AeronConnection


s/sink/receiver

s/sink/receiver

--- src/overtone/studio/midi.clj
+++ src/overtone/studio/midi.clj
@@ -415,9 +415,10 @@

 (defn midi-sysex
   "Send a midi System Exclusive msg made up of the bytes in byte-seq
-   byte-array, sequence of integers, longs or a byte-string to the sink.
-   If a byte string is specified, must only contain bytes encoded as hex
-   values.  Commas, spaces, and other whitespace is ignored.
+   byte-array, sequence of integers, longs or a byte-string to the
+   receiver.  If a byte string is specified, must only contain bytes
+   encoded as hex values.  Commas, spaces, and other whitespace is
+   ignored.

    See connected-midi-receivers for a full list of available receivers."
   [rcv byte-seq]


Add handy lookup fns midi-device-num and midi-full-device-key. These fns should preferred to looking up the information via the namespaced keywords.

--- src/overtone/studio/midi.clj
+++ src/overtone/studio/midi.clj
@@ -398,3 +398,13 @@
    release."
   []
   connected-midi-receivers*)
+
+(defn midi-device-num
+  "Returns the device number for the specified MIDI device"
+  [dev]
+  (::dev-num dev))
+
+(defn midi-full-device-key
+  "Returns the full device key for the specified MIDI device"
+  [dev]
+  (::full-device-key dev))


] instead of )

] instead of )

--- src/paulkrake/datacenter.clj
+++ src/paulkrake/datacenter.clj
@@ -23,7 +23,7 @@
    "passes_failed"
    "crosses_right"
    "balls_touched"
-   "tracking_sprints" "shots" "corner_kicks" "duels_won_header" "average_age" "duels_won_ground" "offsides" "passes_failed_percentage" "card_yellow_red" "shots_outside_box" "tracking_max_speed" "shots_on_goal" "tracking_average_speed"  "tracking_distance" "corner_kicks_right" "card_yellow"))
+   "tracking_sprints" "shots" "corner_kicks" "duels_won_header" "average_age" "duels_won_ground" "offsides" "passes_failed_percentage" "card_yellow_red" "shots_outside_box" "tracking_max_speed" "shots_on_goal" "tracking_average_speed"  "tracking_distance" "corner_kicks_right" "card_yellow"])

 (defn to-clj-unmemoized [uri]
   (->> uri slurp json/read-str ))


Convert between radians and degrees and update the origin x/y

--- src/play_clj/g2d_physics.clj
+++ src/play_clj/g2d_physics.clj
@@ -2,7 +2,7 @@
   (:require [play-clj.core :as c]
             [play-clj.math :as m]
             [play-clj.utils :as u])
-  (:import [com.badlogic.gdx.math Vector2]
+  (:import [com.badlogic.gdx.math MathUtils Vector2]
            [com.badlogic.gdx.physics.box2d Body BodyDef ChainShape CircleShape
             Contact ContactListener EdgeShape Fixture FixtureDef Joint JointDef
             PolygonShape Transform]))
@@ -75,12 +75,20 @@

 (defn ^:private body-angle
   [entity]
-  (.getRotation ^Transform (body! entity :get-transform)))
+  (* (body! entity :get-angle) MathUtils/radiansToDegrees))
+
+(defn ^:private body-origin-x
+  [entity]
+  (. ^Vector2 (body! entity :get-local-center) x))
+
+(defn ^:private body-origin-y
+  [entity]
+  (. ^Vector2 (body! entity :get-local-center) y))

 (defn body-position!
-  "Changes the position of the body in `entity`."
+  "Changes the position of the body in `entity`. The angle is in degrees."
   [entity x y angle]
-  (body! entity :set-transform x y angle))
+  (body! entity :set-transform x y (* angle MathUtils/degreesToRadians)))

 (defn body-x!
   "Changes the `x` of the body in `entity`."
@@ -93,7 +101,7 @@
   (body-position! entity (body-x entity) y (body-angle entity)))

 (defn body-angle!
-  "Changes the `angle` of the body in `entity`."
+  "Changes the `angle` (degrees) of the body in `entity`."
   [entity angle]
   (body-position! entity (body-x entity) (body-y entity) angle))

@@ -264,6 +272,8 @@
              (assoc e
                     :x (body-x e)
                     :y (body-y e)
-                    :angle (body-angle e))
+                    :angle (body-angle e)
+                    :origin-x (body-origin-x e)
+                    :origin-y (body-origin-y e))
              e))
          entities)))


~basecamp: babel.generate/use-spec-cache? true

--- src/babel/english/lab.cljc
+++ src/babel/english/lab.cljc
@@ -50,7 +50,8 @@
                                                      :rest []}}}}}}}]]
     (repeatedly #(println
                   (let [spec (first (shuffle specs))]
-                    (let [result (morph (time (binding [babel.generate/truncate? true]
+                    (let [result (morph (time (binding [babel.generate/truncate? true
+                                                        babel.generate/use-spec-cache? true]
                                                 (wait wait-ms-for-generation (fn [] (generate spec model))))))]
                       (or (and (not (empty? result)) result)
                           "TIMEOUT.")))))))


cleanup

cleanup

--- src/babel/francais/pos.clj
+++ src/babel/francais/pos.clj
@@ -84,6 +84,3 @@
               :agr {:gender gender}
               :sem {:gender gender}
               :subcat '()}}))
-
-
-


loading the sql queries with connection key, as required by yesql >0.5

--- src/bitfondue/database.clj
+++ src/bitfondue/database.clj
@@ -1,7 +1,8 @@
 (ns bitfondue.database
   (:require [cheshire.core :as cheshire]
             [yesql.core :refer [defqueries]]
-            [clojure.java.jdbc :as jdbc])
+            [clojure.java.jdbc :as jdbc]
+            [bitfondue.config :as config])
   (:import [org.postgresql.util PGobject]))

 (extend-type org.postgresql.util.PGobject
@@ -13,5 +14,6 @@
         (cheshire/parse-string (.getValue val) true)
         val))))

-(defqueries "bitfondue/queries.sql")
+(defqueries "bitfondue/queries.sql"
+  {:connection config/database})


add CODED constant

add CODED constant

--- src/processing/constants.clj
+++ src/processing/constants.clj
@@ -171,6 +171,8 @@

 ;; keys

+(def CODED PConstants/CODED)
+
 (def BACKSPACE PApplet/BACKSPACE)
 (def TAB PApplet/TAB)
 (def ENTER PApplet/ENTER)


Made allowances for more than a single hard-coded driver to be loaded.

--- src/blutwurst/database.clj
+++ src/blutwurst/database.clj
@@ -1,7 +1,20 @@
 (ns blutwurst.database
-  (:require [taoensso.timbre :as timbre :refer [trace]])
+  (:require [taoensso.timbre :as timbre :refer [trace]]
+            [clojure.string :as cstring])
   (:import (java.sql DriverManager JDBCType)
            (java.lang Class)))
+
+(def ^:private jdbc-drivers
+ {
+    "jdbc:sqlite:" { :classname "org.sqlite.JDBC" }
+    "jdbc:derby:" { :classname "org.apache.derby.jdbc.EmbeddedDriver" }
+ })
+
+(defn- find-class-for-spec [spec]
+ (let [driver-entries (filter #(cstring/starts-with? (:connection-string spec) (first %)) jdbc-drivers)]
+  (trace "Found drivers: " (pr-str (seq driver-entries)))
+  (:classname (second (first driver-entries)))
+  ))

 (defmacro with-jdbc-meta-data
  "Accepts a specification object and a function accepting a single argument (metadata).
@@ -12,11 +25,13 @@
        meta-data-name (gensym)
        result-name (gensym)
        d (gensym)]
-   `(let [~d (.newInstance (Class/forName "org.sqlite.JDBC"))
-          ~connection-name (DriverManager/getConnection (:connection-string ~spec))
-          ~meta-data-name (.getMetaData ~connection-name)
-          ~result-name (apply ~fun (list ~meta-data-name))]
-      ~result-name)
+   `(do
+       (.newInstance (Class/forName (find-class-for-spec ~spec)))
+
+       (let [~connection-name (DriverManager/getConnection (:connection-string ~spec))
+             ~meta-data-name (.getMetaData ~connection-name)
+             ~result-name (apply ~fun (list ~meta-data-name))]
+            ~result-name))
  ))

 (defn- read-table-row [rs] {


Nest TOC and TOCI properly

Nest TOC and TOCI properly

Nested toc levels have to contain a TOC again. Also make sure the Lbl
roles are used instead of Reference and the alt text is added to the
links. Finally do not use percent for line-height.

--- src/catalog/layout/fop.clj
+++ src/catalog/layout/fop.clj
@@ -159,10 +159,10 @@

 (defn- toc-entry
   [items path depth current-depth {:keys [path-to-numbers] :as opts}]
-  [:fo:block {:text-align-last "justify" :role "TOCI"
-              :start-indent (str (- current-depth 1) "em")}
-   [:fo:basic-link {:internal-destination (hash path)}
-    (inline {:role "Reference"}
+  [:fo:block {:text-align-last "justify" :role "TOCI"}
+   [:fo:basic-link {:internal-destination (hash path)
+                    :fox:alt-text (format "Link nach %s" (layout/translations (last path))) }
+    (inline {:role "Lbl"}
             (when-let [numbers (get path-to-numbers path)] (section-numbers numbers))
             (let [title (last path)]
               (if (keyword? title) (layout/translations title) title)))
@@ -170,23 +170,33 @@
     [:fo:page-number-citation {:ref-id (hash path) :role "Reference"}]]
    (cond
      (and (map? items) (< current-depth depth))
-     (map #(toc-entry (get items %) (conj path %) depth (inc current-depth) opts)
-          (keys items))
+     (block {:role "TOC"
+             :start-indent (str current-depth " * 1em")}
+      (map #(toc-entry (get items %) (conj path %) depth (inc current-depth) opts)
+           (keys items)))
      ;; check for headings in markdown
      (and (string? items)
           ;; only show in the toc if there are multiple headings (I
           ;; guess this is a weird way of saying we don't want any
           ;; subheadings in the toc for :grossdruck)
           (< 1 (count (md-extract-headings items))))
-     (map #(toc-entry % (conj path %) depth (inc current-depth) opts)
-          (md-extract-headings items)))])
+     (block {:role "TOC"
+             :start-indent (str current-depth " * 1em")}
+      (map #(toc-entry % (conj path %) depth (inc current-depth) opts)
+           (md-extract-headings items))))])

 (defn toc [items path depth {:keys [heading?] :as opts}]
   (when (map? items)
-    [:fo:block {:line-height "150%"
-                :role "TOC"}
+    [:fo:block (if heading?
+                 ;; if the toc has a heading we assume that it is the
+                 ;; first toc. The following content should start on
+                 ;; an odd page
+                 {:role "NonStruct" :break-after "odd-page"}
+                 {:role "NonStruct"})
      (when heading? (heading :h1 [:inhalt] opts))
-     (map #(toc-entry (get items %) (conj path %) depth 1 opts) (keys items))]))
+     [:fo:block {:line-height "1.5"
+                 :role "TOC"}
+      (map #(toc-entry (get items %) (conj path %) depth 1 opts) (keys items))]]))

 (defn- narrators-sexp [narrators]
   (let [narrator (first narrators)]


Improve performance of `either?` performance for most common cases.

--- src/cats/monad/either.cljc
+++ src/cats/monad/either.cljc
@@ -137,9 +137,15 @@
   "Return true in case of `v` is instance
   of Either monad."
   [v]
-  (if (satisfies? p/Contextual v)
+  (cond
+    (or (instance? Right v)
+        (instance? Left v))
+    true
+
+    (satisfies? p/Contextual v)
     (identical? (p/-get-context v) context)
-    false))
+
+    :else false))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Monad definition


nicer docs and map-key extraction

nicer docs and map-key extraction

--- src/celestial/provider.clj
+++ src/celestial/provider.clj
@@ -12,6 +12,7 @@
 (ns celestial.provider
   "common providers functions"
     (:require
+      [flatland.useful.map :refer (dissoc-in*)]
       [subs.core :refer (validation when-not-nil)]
       [supernal.sshj :refer (ssh-up?)]
       [celestial.model :refer (hypervisor)]
@@ -44,7 +45,7 @@
      (apply juxt (map select kys)))))

 (defn os->template
-  "Os key to vmware template"
+  "Os key to template/VM/image"
   [hyp]
   (fn [os]
     (let [ks [hyp :ostemplates os]]
@@ -80,6 +81,9 @@
                (catch Throwable e false))
             {:type ::ssh-failed :timeout timeout} "Timed out while waiting for ssh"))

+(defn map-key [m from to]
+  (dissoc-in* (assoc-in m to (get-in m from)) from))
+
 ; common validations
 (validation :ip
     (when-not-nil (partial re-find #"\d+\.\d+\.\d+\.\d+") "must be a legal ip address"))


detecting corrupted bcrypt error

detecting corrupted bcrypt error

--- src/celestial/security.clj
+++ src/celestial/security.clj
@@ -15,6 +15,7 @@
     [gelfino.timbre :only (set-tid)]
     [celestial.common :only (import-logging)])
   (:require
+    [slingshot.slingshot :refer  [throw+ try+]]
     [celestial.roles :as roles]
     [celestial.persistency :as p]
     [clojure.core.strint :refer (<<)]
@@ -51,11 +52,22 @@
   {:post [(not-empty (% :password ))]}
   (p/get-user! id))

+(defn check-creds
+   "Runs bcrypt password check if user exists"
+  [creds]
+  (if (p/user-exists? (:username creds))
+    (try
+      (creds/bcrypt-credential-fn user-with-pass creds)
+      (catch IllegalArgumentException e
+       (throw+ {:msg "Please ask admin to reset your password, persisted hashed version has been correupted"})))
+
+    nil))
+
 (defn secured-app [routes]
   (friend/authenticate
     (friend/wrap-authorize (user-tracking routes) roles/user)
     {:allow-anon? false
-     :credential-fn #(if (p/user-exists? (:username %)) (creds/bcrypt-credential-fn user-with-pass %) nil)
+     :credential-fn check-creds
      :unauthenticated-handler sign-in-resp
      :workflows [
         (workflows/interactive-form :login-failure-handler login-redirect)


Correct spelling

Correct spelling

--- src/re_frame/middleware.cljs
+++ src/re_frame/middleware.cljs
@@ -159,7 +159,7 @@
   todo removal.
   And to perform this enrichment, a function has to inspect all the todos,
   possibly set flags on each, and set some overall list of duplicates.
-  And this duplication check might just be one check amoung many.
+  And this duplication check might just be one check among many.
   \"f\" would need to be both adding and removing the duplicate warnings.
   By applying \"f\" in middleware, we keep the handlers simple and yet we
   ensure this important step is not missed."


Actually fix SSH delay settings

Actually fix SSH delay settings

--- src/circle/backend/ssh.clj
+++ src/circle/backend/ssh.clj
@@ -61,7 +61,7 @@
                                :strict-host-key-checking :no)]
       (try-try-again
        {:sleep 1000
-        :default 30
+        :tries 30
         :catch [com.jcraft.jsch.JSchException]
         :error-hook (fn [e] (errorf "caught %s" e))}
        #(try


Force lazy seq in interpret-seq to be realized (#147) (#149)

--- src/sablono/interpreter.cljc
+++ src/sablono/interpreter.cljc
@@ -105,7 +105,10 @@
 (defn- interpret-seq
   "Interpret the seq `x` as HTML elements."
   [x]
-  (map interpret x))
+  ;; Forces the seq x to be realized to avoid a problem caused by a combination
+  ;; of lazy seq and binding (e.g. implementation of om.core/build-all).
+  ;; https://github.com/r0man/sablono/issues/147
+  (into [] (map interpret) x))

 #?(:cljs
    (defn element


CLJS-1176: redirect node REPL output through *out* and *err*, not System/out, System/err

--- src/clj/cljs/repl/node.clj
+++ src/clj/cljs/repl/node.clj
@@ -17,8 +17,9 @@
             [clojure.data.json :as json])
   (:import java.net.Socket
            java.lang.StringBuilder
-           [java.io File BufferedReader BufferedWriter]
-           [java.lang ProcessBuilder ProcessBuilder$Redirect]))
+           [java.io File BufferedReader BufferedWriter InputStream
+            Writer InputStreamReader IOException]
+           [java.lang ProcessBuilder Process]))

 (defn socket [host port]
   (let [socket (Socket. host port)
@@ -77,6 +78,20 @@
 (defn platform-path [v]
   (str "path.join.apply(null, " (seq->js-array v) ")"))

+(defn- pipe [^Process proc in ^Writer out]
+  ;; we really do want system-default encoding here
+  (with-open [^java.io.Reader in (-> in InputStreamReader. BufferedReader.)]
+    (loop [buf (char-array 1024)]
+      (when (.isAlive proc)
+        (try
+          (let [len (.read in buf)]
+            (when-not (neg? len)
+              (.write out buf 0 len)))
+          (catch IOException e
+            (when (and (.isAlive proc) (not (.contains (.getMessage e) "Stream closed")))
+              (.printStackTrace e *err*))))
+        (recur buf)))))
+
 (defn setup
   ([repl-env] (setup repl-env nil))
   ([repl-env opts]
@@ -87,12 +102,11 @@
                 (string/replace (slurp (io/resource "cljs/repl/node_repl.js"))
                   "var PORT = 5001;"
                   (str "var PORT = " (:port repl-env) ";")))
-          bldr (ProcessBuilder. (into-array [(get opts :node-command "node")]))
-          _    (-> bldr
+          proc (-> (ProcessBuilder. (into-array [(get opts :node-command "node")]))
                  (.redirectInput of)
-                 (.redirectOutput ProcessBuilder$Redirect/INHERIT)
-                 (.redirectError ProcessBuilder$Redirect/INHERIT))
-          proc (.start bldr)
+                 .start)
+          _ (do (future (pipe proc (.getInputStream proc) *out*))
+                (future (pipe proc (.getErrorStream proc) *err*)))
           env  (ana/empty-env)
           core (io/resource "cljs/core.cljs")
           ;; represent paths as vectors so we can emit JS arrays, this is to


Add expiry timestamp to sessions

Add expiry timestamp to sessions

--- src/clj/salava/user/db.clj
+++ src/clj/salava/user/db.clj
@@ -432,8 +432,9 @@

 (defn set-session [ctx ok-status user-id]
   (let [{:keys [role id private activated]} (user-information ctx user-id)
-        last-visited (last-visited ctx user-id)]
-    (assoc-in ok-status [:session :identity] {:id id :role role :private private :activated activated :last-visited last-visited})))
+        last-visited (last-visited ctx user-id)
+        expires (+ (long (/ (System/currentTimeMillis) 1000)) (* 8 60 60))]
+    (assoc-in ok-status [:session :identity] {:id id :role role :private private :activated activated :last-visited last-visited :expires expires})))

 (defn finalize-login [ctx ok-res user-id pending-badge-id new-account]
   (save-pending-badge-and-email ctx user-id pending-badge-id new-account)


Computing and printing factorials and prime factors

--- src/clj_mrazik/irc_bot.clj
+++ src/clj_mrazik/irc_bot.clj
@@ -75,6 +75,22 @@
     [n]
     (reduce *' (range 1 (inc n))))

+(defn print-factorial
+    [input]
+    (factorial (Integer/parseInt (subs input 0 (dec (count input))))))
+
+(defn print-prime-factors
+    [input]
+    (str input " = " (clojure.string/join " x " (primefactors (Integer/parseInt input)))))
+
+(defn is-number?
+    [input]
+    (re-matches #"[0-9]+" input))
+
+(defn is-factorial?
+    [input]
+    (re-matches #"[0-9]+!" input))
+
 (defn prepare-reply-text
     [incomming-message nick input-text]
     (let [in-channel? (message-to-channel? incomming-message)
@@ -92,6 +108,9 @@
                           "die"      "thanks for your feedback, I appreciate it"
                           "Good bot" "I know"
                           "Good bot." "I know"
+                          (condp
+                              (is-number? input)    (print-prime-factors input)
+                              (is-factorial? input) (print-factorial input)
                                                     (random-message)))]
         (str prefix response)))