prototype of output xml config

prototype of output xml config

--- configuration/xml-output-extent.clj
+++ configuration/xml-output-extent.clj
@@ -0,0 +1,488 @@
+(foreach :AdminDomain
+         (add-token [:glue:Domains :AdminDomain]
+                    (mapping :CreationTime [:CreationTime-attribute])
+                    (mapping :Validity [:Validity-attribute])
+                    (mapping :Distributed [:Distributed :Distributed-text-node])
+                    (mapping :Owner [:Owner :Owner-text-node])
+                    (mapping :WWW [:WWW :WWW-text-node])
+                    (mapping :Description [:Description :Description-text-node])
+                    (mapping :ID [:ID :ID-text-node])
+                    (mapping :Name [:Name :Name-text-node])
+                    (mapping :OtherInfo [:OtherInfo :OtherInfo-text-node])))
+
+;(foreach [:glue:Domains :AdminDomain]
+;         (add-instance :AdminDomain
+;                       (mapping [:CreationTime-attribute] :CreationTime)
+;                       (mapping [:Validity-attribute] :Validity)
+;                       (mapping [:Distributed :Distributed-text-node] :Distributed)
+;                       (mapping [:Owner :Owner-text-node] :Owner)
+;                       (mapping [:WWW :WWW-text-node] :WWW)
+;                       (mapping [:Description :Description-text-node] :Description)
+;                       (mapping [:ID :ID-text-node] :ID)
+;                       (mapping [:Name :Name-text-node] :Name)
+;                       (mapping [:OtherInfo :OtherInfo-text-node] :OtherInfo)))
+
+(foreach :Location
+         (associated-with [:glue:Domains :AdminDomain] :Domain :PrimaryLocatedAtDomainLocation :Location
+                        (add-token [:Location]
+                                   (mapping :CreationTime [:CreationTime-attribute])
+                                   (mapping :Validity [:Validity-attribute])
+                                   (mapping :ID [:LocalID :LocalID-text-node])
+                                   (mapping :Name [:Name :Name-text-node])
+                                   (mapping :Address [:Address :Address-text-node])
+                                   (mapping :Place [:Place :Place-text-node])
+                                   (mapping :Country [:Country :Country-text-node])
+                                   (mapping :PostCode [:PostCode :PostCode-text-node])
+                                   (mapping :Latitude [:Latitude :Latitude-text-node])
+                                   (mapping :Longitude [:Longitude :Longitude-text-node]))))
+
+;(foreach [:glue:Domains :AdminDomain :Location]
+;         (add-instance :Location
+;                       (mapping [:CreationTime-attribute] :CreationTime)
+;                       (mapping [:Validity-attribute] :Validity)
+;                       (mapping [:LocalID :LocalID-text-node] :ID)
+;                       (mapping [:Name :Name-text-node] :Name)
+;                       (mapping [:Address :Address-text-node] :Address)
+;                       (mapping [:Place :Place-text-node] :Place)
+;                       (mapping [:Country :Country-text-node] :Country)
+;                       (mapping [:PostCode :PostCode-text-node] :PostCode)
+;                       (mapping [:Latitude :Latitude-text-node] :Latitude)
+;                       (mapping [:Longitude :Longitude-text-node] :Longitude)))
+;
+;(foreach [:glue:Domains :AdminDomain]
+;         (add-association :PrimaryLocatedAtDomainLocation
+;                          (mapping [:Location] :Location)
+;                          (mapping [] :Domain)))
+
+(foreach :Contact
+         (associated-with [:glue:Domains :AdminDomain] :Domain :HasContactDomain :Contact
+                        (add-token [:Contact]
+                                   (mapping :CreationTime [:CreationTime-attribute])
+                                   (mapping :Validity [:Validity-attribute])
+                                   (mapping :ID [:LocalID :LocalID-text-node])
+                                   (mapping :OtherInfo [:OtherInfo :OtherInfo-text-node])
+                                   (mapping :Type [:Type :Type-text-node])
+                                   (mapping :Detail [:URL :URL-text-node]))))
+
+;(foreach [:glue:Domains :AdminDomain :Contact]
+;         (add-instance :Contact
+;                       (mapping [:CreationTime-attribute] :CreationTime)
+;                       (mapping [:Validity-attribute] :Validity)
+;                       (mapping [:LocalID :LocalID-text-node] :ID)
+;                       (mapping [:OtherInfo :OtherInfo-text-node] :OtherInfo)
+;                       (mapping [:Type :Type-text-node] :Type)
+;                       (mapping [:URL :URL-text-node] :Detail)))
+;
+;(foreach [:glue:Domains :AdminDomain]
+;         (add-association :HasContactDomain
+;                          (mapping [:Contact] :Contact)
+;                          (mapping [] :Domain)))
+
+(foreach :Service
+         (associated-with [:glue:Domains :AdminDomain] :AdminDomain :ManagesAdminDomainService :Service
+                        (add-token [:Services :Service]
+                                   (mapping :ID [:ID :ID-text-node])
+                                   (mapping :Name [:Name :Name-text-node])
+                                   (mapping :Capability [:Capability :Capability-text-node])
+                                   (mapping :Type [:Type :Type-text-node])
+                                   (mapping :QualityLevel [:QualityLevel :QualityLevel-text-node])
+                                   (mapping :Complexity [:Complexity :Complexity-text-node]))))
+
+;(foreach [:glue:Domains :AdminDomain :Services :Service]
+;         (add-instance :Service
+;                       (mapping [:ID :ID-text-node] :ID)
+;                       (mapping [:Name :Name-text-node] :Name)
+;                       (mapping [:Capability :Capability-text-node] :Capability)
+;                       (mapping [:Type :Type-text-node] :Type)
+;                       (mapping [:QualityLevel :QualityLevel-text-node] :QualityLevel)
+;                       (mapping [:Complexity :Complexity-text-node] :Complexity)))
+;
+;(foreach [:glue:Domains :AdminDomain]
+;         (add-association :ManagesAdminDomainService
+;                          (mapping [:Services :Service] :Service)
+;                          (mapping [] :AdminDomain)))
+
+(foreach :Location
+         (associated-with [:glue:Domains :AdminDomain :Services :Service] :Service :PrimaryLocatedAtServiceLocation :Location
+                        (add-token [:Location]
+                                   (mapping :ID [:LocalID :LocalID-text-node])
+                                   (mapping :Name [:Name :Name-text-node])
+                                   (mapping :Address [:Address :Address-text-node])
+                                   (mapping :Place [:Place :Place-text-node])
+                                   (mapping :Country [:Country :Country-text-node])
+                                   (mapping :PostCode [:PostCode :PostCode-text-node])
+                                   (mapping :Latitude [:Latitude :Latitude-text-node])
+                                   (mapping :Longitude [:Longitude :Longitude-text-node]))))
+
+;(foreach [:glue:Domains :AdminDomain :Services :Service :Location]
+;         (add-instance :Location
+;                       (mapping [:LocalID :LocalID-text-node] :ID)
+;                       (mapping [:Name :Name-text-node] :Name)
+;                       (mapping [:Address :Address-text-node] :Address)
+;                       (mapping [:Place :Place-text-node] :Place)
+;                       (mapping [:Country :Country-text-node] :Country)
+;                       (mapping [:PostCode :PostCode-text-node] :PostCode)
+;                       (mapping [:Latitude :Latitude-text-node] :Latitude)
+;                       (mapping [:Longitude :Longitude-text-node] :Longitude)))
+;
+;(foreach [:glue:Domains :AdminDomain :Services :Service]
+;         (add-association :PrimaryLocatedAtServiceLocation
+;                          (mapping [:Location] :Location)
+;                          (mapping [] :Service)))
+
+(foreach :Contact
+         (associated-with [:glue:Domains :AdminDomain :Services :Service] :Service :HasContactServices :Contact
+                        (add-token [:Contact]
+                                   (mapping :ID [:LocalID :LocalID-text-node])
+                                   (mapping :OtherInfo [:OtherInfo :OtherInfo-text-node])
+                                   (mapping :Type [:Type :Type-text-node])
+                                   (mapping :Detail [:URL :URL-text-node]))))
+
+;(foreach [:glue:Domains :AdminDomain :Services :Service :Contact]
+;         (add-instance :Contact
+;                       (mapping [:LocalID :LocalID-text-node] :ID)
+;                       (mapping [:OtherInfo :OtherInfo-text-node] :OtherInfo)
+;                       (mapping [:Type :Type-text-node] :Type)
+;                       (mapping [:URL :URL-text-node] :Detail)))
+;
+;(foreach [:glue:Domains :AdminDomain :Services :Service]
+;         (add-association :HasContactServices
+;                          (mapping [:Contact] :Contact)
+;                          (mapping [] :Service)))
+
+(foreach :Endpoint
+         (associated-with [:glue:Domains :AdminDomain :Services :Service] :Service :ExposesServiceEndpoint :Endpoint
+                        (add-token [:Endpoint]
+                                   (mapping :ID [:ID :ID-text-node])
+                                   (mapping :Name [:Name :Name-text-node])
+                                   (mapping :URL [:URL :URL-text-node])
+                                   (mapping :Capability [:Capability :Capability-text-node])
+                                   (mapping :Technology [:Technology :Technology-text-node])
+                                   (mapping :InterfaceName [:Interface :Interface-text-node])
+                                   (mapping :InterfaceExtension [:InterfaceExtension :InterfaceExtension-text-node])
+                                   (mapping :WSDL [:WSDL :WSDL-text-node])
+                                   (mapping :SupportedProfile [:SupportedProfile :SupportedProfile-text-node])
+                                   (mapping :Semantics [:Semantics :Semantics-text-node])
+                                   (mapping :Implementor [:Implementor :Implementor-text-node])
+                                   (mapping :ImplementationName [:ImplementationName :ImplementationName-text-node])
+                                   (mapping :ImplementationVersion [:ImplementationVersion :ImplementationVersion-text-node])
+                                   (mapping :QualityLevel [:QualityLevel :QualityLevel-text-node])
+                                   (mapping :HealthState [:HealthState :HealthState-text-node])
+                                   (mapping :HealthStateInfo [:HealthStateInfo :HealthStateInfo-text-node])
+                                   (mapping :ServingState [:ServingState :ServingState-text-node])
+                                   (mapping :StartTime [:StartTime :StartTime-text-node])
+                                   (mapping :IssuerCA [:IssuerCA :IssuerCA-text-node])
+                                   (mapping :TrustedCA [:TrustedCA :TrustedCA-text-node])
+                                   (mapping :DowntimeAnnounce [:DowntimeAnnounce :DowntimeAnnounce-text-node])
+                                   (mapping :DowntimeStart [:DowntimeStart :DowntimeStart-text-node])
+                                   (mapping :DowntimeEnd [:DowntimeEnd :DowntimeEnd-text-node])
+                                   (mapping :DowntimeInfo [:DowntimeInfo :DowntimeInfo-text-node]))))
+
+;(foreach [:glue:Domains :AdminDomain :Services :Service :Endpoint]
+;         (add-instance :Endpoint
+;                       (mapping [:ID :ID-text-node] :ID)
+;                       (mapping [:Name :Name-text-node] :Name)
+;                       (mapping [:URL :URL-text-node] :URL)
+;                       (mapping [:Capability :Capability-text-node] :Capability)
+;                       (mapping [:Technology :Technology-text-node] :Technology)
+;                       (mapping [:Interface :Interface-text-node] :InterfaceName)
+;                       (mapping [:InterfaceExtension :InterfaceExtension-text-node] :InterfaceExtension)
+;                       (mapping [:WSDL :WSDL-text-node] :WSDL)
+;                       (mapping [:SupportedProfile :SupportedProfile-text-node] :SupportedProfile)
+;                       (mapping [:Semantics :Semantics-text-node] :Semantics)
+;                       (mapping [:Implementor :Implementor-text-node] :Implementor)
+;                       (mapping [:ImplementationName :ImplementationName-text-node] :ImplementationName)
+;                       (mapping [:ImplementationVersion :ImplementationVersion-text-node] :ImplementationVersion)
+;                       (mapping [:QualityLevel :QualityLevel-text-node] :QualityLevel)
+;                       (mapping [:HealthState :HealthState-text-node] :HealthState)
+;                       (mapping [:HealthStateInfo :HealthStateInfo-text-node] :HealthStateInfo)
+;                       (mapping [:ServingState :ServingState-text-node] :ServingState)
+;                       (mapping [:StartTime :StartTime-text-node] :StartTime)
+;                       (mapping [:IssuerCA :IssuerCA-text-node] :IssuerCA)
+;                       (mapping [:TrustedCA :TrustedCA-text-node] :TrustedCA)
+;                       (mapping [:DowntimeAnnounce :DowntimeAnnounce-text-node] :DowntimeAnnounce)
+;                       (mapping [:DowntimeStart :DowntimeStart-text-node] :DowntimeStart)
+;                       (mapping [:DowntimeEnd :DowntimeEnd-text-node] :DowntimeEnd)
+;                       (mapping [:DowntimeInfo :DowntimeInfo-text-node] :DowntimeInfo)))
+;
+;(foreach [:glue:Domains :AdminDomain :Services :Service]
+;         (add-association :ExposesServiceEndpoint
+;                          (mapping [:Endpoint] :Endpoint)
+;                          (mapping [] :Service)))
+
+(foreach :AccessPolicy
+         (associated-with [:glue:Domains :AdminDomain :Services :Service :Endpoint] :Endpoint :CanAccessAccessPolicyEndpoint :AccessPolicy
+                          (add-token [:AccessPolicy]
+                                     (mapping :CreationTime [:CreationTime-attribute])
+                                     (mapping :Validity [:Validity-attribute])
+                                     (mapping :ID [:LocalID :LocalID-text-node])
+                                     (mapping :Scheme [:Scheme :Scheme-text-node])
+                                     (mapping :Rule [:Rule :Rule-text-node]))))
+
+;(foreach [:glue:Domains :AdminDomain :Services :Service :Endpoint :AccessPolicy]
+;         (add-instance :AccessPolicy
+;                       (mapping [:CreationTime-attribute] :CreationTime)
+;                       (mapping [:Validity-attribute] :Validity)
+;                       (mapping [:LocalID :LocalID-text-node] :ID)
+;                       (mapping [:Scheme :Scheme-text-node] :Scheme)
+;                       (mapping [:Rule :Rule-text-node] :Rule)))
+;
+;(foreach [:glue:Domains :AdminDomain :Services :Service :Endpoint]
+;         (add-association :CanAccessAccessPolicyEndpoint
+;                          (mapping [:AccessPolicy] :AccessPolicy)
+;                          (mapping [] :Endpoint)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;(foreach [:glue:Domains :AdminDomain :Services :Service :Endpoint]
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;         (add-association :SubmittedByEndpointActivity
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;                          (mapping-pk [:Associations :ActivityID :ActivityID-text-node] :Activity)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;                          (mapping [] :Endpoint)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;(foreach [:glue:Domains :AdminDomain :Services :Service :Activities :Activity]
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;         (add-instance :Activity
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;                       (mapping [:ID :ID-text-node] :ID)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;(foreach [:glue:Domains :AdminDomain :Services :Service :Activities :Activity]
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;         (add-association :SubmittedByEndpointActivity
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;                          (mapping-pk [:Associations :EndpointID :EndpointID-text-node] :Endpoint)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;                          (mapping [] :Activity)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;(foreach [:glue:Domains :AdminDomain :Services :Service :Activities :Activity]
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;         (add-association :CreatesActivityUserDomain
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;                          (mapping-pk [:Associations :UserDomainID :UserDomainID-text-node] :UserDomain)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;                          (mapping [] :Activity)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;(foreach [:glue:Domains :AdminDomain :Services :Service :Activities :Activity]
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;         (add-association :RelatesToActivityActivity
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;                          (mapping-pk [:Associations :ActivityID :ActivityID-text-node] :Activity)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;                          (mapping [] :ToActivity)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;(foreach [:glue:Domains :AdminDomain :Services :Service]
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;         (add-association :RelatesToServiceService
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;                          (mapping-pk [:Associations :ServiceID :ServiceID-text-node] :Service)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;                          (mapping [] :ToService)))
+
+(foreach :Service
+         (associated-with [:glue:Domains :AdminDomain] :AdminDomain :ManagesAdminDomainService :Service
+                          (add-token [:Services :ComputingService]
+                                     (mapping :CreationTime [:CreationTime-attribute])
+                                     (mapping :Validity [:Validity-attribute])
+                                     (mapping :ID [:ID :ID-text-node])
+                                     (mapping :Name [:Name :Name-text-node])
+                                     (mapping :Capability [:Capability :Capability-text-node])
+                                     (mapping :Type [:Type :Type-text-node])
+                                     (mapping :QualityLevel [:QualityLevel :QualityLevel-text-node])
+                                     (mapping :StatusInfo [:StatusPage])
+                                     (mapping :Complexity [:Complexity :Complexity-text-node]))))
+
+;(foreach [:glue:Domains :AdminDomain :Services :ComputingService]
+;         (add-instance :Service
+;                       (mapping [:CreationTime-attribute] :CreationTime)
+;                       (mapping [:Validity-attribute] :Validity)
+;                       (mapping [:ID :ID-text-node] :ID)
+;                       (mapping [:Name :Name-text-node] :Name)
+;                       (mapping [:Capability :Capability-text-node] :Capability)
+;                       (mapping [:Type :Type-text-node] :Type)
+;                       (mapping [:QualityLevel :QualityLevel-text-node] :QualityLevel)
+;                       (mapping [:StatusPage] :StatusInfo)
+;                       (mapping [:Complexity :Complexity-text-node] :Complexity)))
+;
+;(foreach [:glue:Domains :AdminDomain]
+;         (add-association :ManagesAdminDomainService
+;                          (mapping [:Services :ComputingService] :Service)
+;                          (mapping [] :AdminDomain)))
+
+(foreach :Location
+         (associated-with [:glue:Domains :AdminDomain :Services :ComputingService] :Service :PrimaryLocatedAtServiceLocation :Location
+                          (add-token [:glue:Domains :AdminDomain :Services :ComputingService :Location]
+                                     (mapping :CreationTime [:CreationTime-attribute])
+                                     (mapping :Validity [:Validity-attribute])
+                                     (mapping :ID [:LocalID :LocalID-text-node])
+                                     (mapping :Name [:Name :Name-text-node])
+                                     (mapping :Address [:Address :Address-text-node])
+                                     (mapping :Place [:Place :Place-text-node])
+                                     (mapping :Country [:Country :Country-text-node])
+                                     (mapping :PostCode [:PostCode :PostCode-text-node])
+                                     (mapping :Latitude [:Latitude :Latitude-text-node])
+                                     (mapping :Longitude [:Longitude :Longitude-text-node]))))
+
+;(foreach [:glue:Domains :AdminDomain :Services :ComputingService :Location]
+;         (add-instance :Location
+;                       (mapping [:CreationTime-attribute] :CreationTime)
+;                       (mapping [:Validity-attribute] :Validity)
+;                       (mapping [:LocalID :LocalID-text-node] :ID)
+;                       (mapping [:Name :Name-text-node] :Name)
+;                       (mapping [:Address :Address-text-node] :Address)
+;                       (mapping [:Place :Place-text-node] :Place)
+;                       (mapping [:Country :Country-text-node] :Country)
+;                       (mapping [:PostCode :PostCode-text-node] :PostCode)
+;                       (mapping [:Latitude :Latitude-text-node] :Latitude)
+;                       (mapping [:Longitude :Longitude-text-node] :Longitude)))
+;
+;(foreach [:glue:Domains :AdminDomain :Services :ComputingService]
+;         (add-association :PrimaryLocatedAtServiceLocation
+;                          (mapping [:Location] :Location)
+;                          (mapping [] :Service)))
+
+(foreach :Contact
+         (associated-with [:glue:Domains :AdminDomain :Services :ComputingService] :Service :HasContactServices :Contact
+                          (add-token [:glue:Domains :AdminDomain :Services :ComputingService :Contact]
+                                     (mapping :CreationTime [:CreationTime-attribute])
+                                     (mapping :Validity [:Validity-attribute])
+                                     (mapping :ID [:LocalID :LocalID-text-node])
+                                     (mapping :OtherInfo [:OtherInfo :OtherInfo-text-node])
+                                     (mapping :Type [:Type :Type-text-node])
+                                     (mapping :Detail [:URL :URL-text-node]))))
+
+;(foreach [:glue:Domains :AdminDomain :Services :ComputingService :Contact]
+;         (add-instance :Contact
+;                       (mapping [:CreationTime-attribute] :CreationTime)
+;                       (mapping [:Validity-attribute] :Validity)
+;                       (mapping [:LocalID :LocalID-text-node] :ID)
+;                       (mapping [:OtherInfo :OtherInfo-text-node] :OtherInfo)
+;                       (mapping [:Type :Type-text-node] :Type)
+;                       (mapping [:URL :URL-text-node] :Detail)))
+;
+;(foreach [:glue:Domains :AdminDomain :Services :ComputingService]
+;         (add-association :HasContactServices
+;                          (mapping [:Contact] :Contact)
+;                          (mapping [] :Service)))
+
+(foreach :Endpoint
+         (associated-with [:glue:Domains :AdminDomain :Services :ComputingService] :Service :ExposesServiceEndpoint :Endpoint
+                          (add-token [:ComputingEndpoint]
+                                     (mapping :CreationTime [:CreationTime-attribute])
+                                     (mapping :Validity [:Validity-attribute])
+                                     (mapping :ID [:ID :ID-text-node])
+                                     (mapping :Name [:Name :Name-text-node])
+                                     (mapping :URL [:URL :URL-text-node])
+                                     (mapping :Technology [:Technology :Technology-text-node])
+                                     (mapping :InterfaceName [:Interface :Interface-text-node])
+                                     (mapping :InterfaceExtension [:InterfaceExtension :InterfaceExtension-text-node])
+                                     (mapping :WSDL [:WSDL :WSDL-text-node])
+                                     (mapping :SupportedProfile [:SupportedProfile :SupportedProfile-text-node])
+                                     (mapping :Semantics [:Semantics :Semantics-text-node])
+                                     (mapping :Implementor [:Implementor :Implementor-text-node])
+                                     (mapping :ImplementationName [:ImplementationName :ImplementationName-text-node])
+                                     (mapping :ImplementationVersion [:ImplementationVersion :ImplementationVersion-text-node])
+                                     (mapping :QualityLevel [:QualityLevel :QualityLevel-text-node])
+                                     (mapping :HealthState [:HealthState :HealthState-text-node])
+                                     (mapping :HealthStateInfo [:HealthStateInfo :HealthStateInfo-text-node])
+                                     (mapping :ServingState [:ServingState :ServingState-text-node])
+                                     (mapping :StartTime [:StartTime :StartTime-text-node])
+                                     (mapping :IssuerCA [:IssuerCA :IssuerCA-text-node])
+                                     (mapping :DowntimeAnnounce [:DowntimeAnnounce :DowntimeAnnounce-text-node])
+                                     (mapping :DowntimeStart [:DowntimeStart :DowntimeStart-text-node])
+                                     (mapping :DowntimeEnd [:DowntimeEnd :DowntimeEnd-text-node])
+                                     (mapping :DowntimeInfo [:DowntimeInfo :DowntimeInfo-text-node]))))
+
+;(foreach [:glue:Domains :AdminDomain :Services :ComputingService :ComputingEndpoint]
+;         (add-instance :Endpoint
+;                       (mapping [:CreationTime-attribute] :CreationTime)
+;                       (mapping [:Validity-attribute] :Validity)
+;                       (mapping [:ID :ID-text-node] :ID)
+;                       (mapping [:Name :Name-text-node] :Name)
+;                       (mapping [:URL :URL-text-node] :URL)
+;                       (mapping [:Technology :Technology-text-node] :Technology)
+;                       (mapping [:Interface :Interface-text-node] :InterfaceName)
+;                       (mapping [:InterfaceExtension :InterfaceExtension-text-node] :InterfaceExtension)
+;                       (mapping [:WSDL :WSDL-text-node] :WSDL)
+;                       (mapping [:SupportedProfile :SupportedProfile-text-node] :SupportedProfile)
+;                       (mapping [:Semantics :Semantics-text-node] :Semantics)
+;                       (mapping [:Implementor :Implementor-text-node] :Implementor)
+;                       (mapping [:ImplementationName :ImplementationName-text-node] :ImplementationName)
+;                       (mapping [:ImplementationVersion :ImplementationVersion-text-node] :ImplementationVersion)
+;                       (mapping [:QualityLevel :QualityLevel-text-node] :QualityLevel)
+;                       (mapping [:HealthState :HealthState-text-node] :HealthState)
+;                       (mapping [:HealthStateInfo :HealthStateInfo-text-node] :HealthStateInfo)
+;                       (mapping [:ServingState :ServingState-text-node] :ServingState)
+;                       (mapping [:StartTime :StartTime-text-node] :StartTime)
+;                       (mapping [:IssuerCA :IssuerCA-text-node] :IssuerCA)
+;                       (mapping [:DowntimeAnnounce :DowntimeAnnounce-text-node] :DowntimeAnnounce)
+;                       (mapping [:DowntimeStart :DowntimeStart-text-node] :DowntimeStart)
+;                       (mapping [:DowntimeEnd :DowntimeEnd-text-node] :DowntimeEnd)
+;                       (mapping [:DowntimeInfo :DowntimeInfo-text-node] :DowntimeInfo)))
+;
+;(foreach [:glue:Domains :AdminDomain :Services :ComputingService]
+;         (add-association :ExposesServiceEndpoint
+;                          (mapping [:ComputingEndpoint] :Endpoint)
+;                          (mapping [] :Service)))
+
+(foreach :AccessPolicy
+         (associated-with [:glue:Domains :AdminDomain :Services :ComputingService :ComputingEndpoint] :Endpoint :CanAccessAccessPolicyEndpoint :AccessPolicy
+                          (add-token [:AccessPolicy]
+                                     (mapping :CreationTime [:CreationTime-attribute])
+                                     (mapping :Validity [:Validity-attribute])
+                                     (mapping :ID [:LocalID :LocalID-text-node])
+                                     (mapping :Scheme [:Scheme :Scheme-text-node])
+                                     (mapping :Rule [:Rule-text-node :Rule]))))
+
+;(foreach [:glue:Domains :AdminDomain :Services :ComputingService :ComputingEndpoint :AccessPolicy]
+;         (add-instance :AccessPolicy
+;                       (mapping [:CreationTime-attribute] :CreationTime)
+;                       (mapping [:Validity-attribute] :Validity)
+;                       (mapping [:LocalID :LocalID-text-node] :ID)
+;                       (mapping [:Scheme :Scheme-text-node] :Scheme)
+;                       (mapping [:Rule-text-node :Rule] :Rule)))
+;
+;(foreach [:glue:Domains :AdminDomain :Services :ComputingService :ComputingEndpoint]
+;         (add-association :CanAccessAccessPolicyEndpoint
+;                          (mapping [:AccessPolicy] :AccessPolicy)
+;                          (mapping [] :Endpoint)))
+
+(foreach :Share
+         (associated-with [:glue:Domains :AdminDomain :Services :ComputingService] :Service :OffersServiceShare :Share
+                          (add-token [:ComputingShares :ComputingShare]
+                                     (mapping :ID [:LocalID :LocalID-text-node])
+                                     (mapping :Name [:Name :Name-text-node]))))
+
+;(foreach [:glue:Domains :AdminDomain :Services :ComputingService :ComputingShares :ComputingShare]
+;         (add-instance :Share
+;                       (mapping [:LocalID :LocalID-text-node] :ID)
+;                       (mapping [:Name :Name-text-node] :Name)))
+;
+;(foreach [:glue:Domains :AdminDomain :Services :ComputingService]
+;         (add-association :OffersServiceShare
+;                          (mapping [:ComputingShares :ComputingShare] :Share)
+;                          (mapping [] :Service)))
+
+; !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! cannot map Type attribute only !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+;(foreach [:glue:Domains :AdminDomain :Services :ComputingService :ComputingActivitites :ComputingActivitiy]
+;         (add-instance :Activitiy
+;                       (mapping [:Type :Type-text-node] :Type)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;(foreach [:glue:Domains :AdminDomain :Services :ComputingService]
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;         (add-association :RelatesToServiceService
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;                          (mapping-pk [:Associations :ServiceID :ServiceID-text-node] :Service)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;                          (mapping [] :ToService)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;(foreach [:glue:Domains :AdminDomain]
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;         (add-association :ParticipatesInAdminDomainAdminDomain
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;                          (mapping-pk [:Associations :AdminDomainID :AdminDomainID-text-node] :AdminDomain)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;                          (mapping [] :ToAdminDomain)))
+
+(foreach :UserDomain
+         (add-token [:glue:Domains :UserDomain]
+                    (mapping :ID [:ID :ID-text-node])
+                    (mapping :Name [:Name :Name-text-node])
+                    (mapping :Description [:Description :Description-text-node])
+                    (mapping :WWW [:WWW :WWW-text-node])
+                    (mapping :OtherInfo [:OtherInfo :OtherInfo-text-node])
+                    (mapping :Level [:Level :Level-text-node])
+                    (mapping :UserManager [:UserManager :UserManager-text-node])
+                    (mapping :Member [:Member :Member-text-node])))
+
+;(foreach [:glue:Domains :UserDomain]
+;         (add-instance :UserDomain
+;                       (mapping [:ID :ID-text-node] :ID)
+;                       (mapping [:Name :Name-text-node] :Name)
+;                       (mapping [:Description :Description-text-node] :Description)
+;                       (mapping [:WWW :WWW-text-node] :WWW)
+;                       (mapping [:OtherInfo :OtherInfo-text-node] :OtherInfo)
+;                       (mapping [:Level :Level-text-node] :Level)
+;                       (mapping [:UserManager :UserManager-text-node] :UserManager)
+;                       (mapping [:Member :Member-text-node] :Member)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;(foreach [:glue:Domains :UserDomain]
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;         (add-association :ParticipatesInUserDomainUserDomain
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;                          (mapping-pk [:Associations :UserDomainID :UserDomainID-text-node] :UserDomain)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;                          (mapping [] :ToUserDomain)))


Docstring editing

Docstring editing

--- src/clojure/clojurewerkz/cassaforte/client.clj
+++ src/clojure/clojurewerkz/cassaforte/client.clj
@@ -24,20 +24,20 @@
 ;;

 (defn round-robin-policy
-  "Round-robin load balancing policy. Each next query is ran on the node that was contacted
-  least recently."
+  "Round-robin load balancing policy. Picks nodes to execute requests on in order."
   []
   (RoundRobinPolicy.))

 (defn dc-aware-round-robin-policy
-  "Datacenter aware load balancing policy. Each next query is ran on the node that was contacted
-  least recently, over the nodes located in current datacenter. Nodes from other datacenters will
-  be tried only after the local nodes."
+  "Datacenter aware load balancing policy.
+
+   Like round-robin but over the nodes located in the same datacenter.
+   Nodes from other datacenters will be tried only if all requests to local nodes fail."
   [^String local-dc]
   (DCAwareRoundRobinPolicy. local-dc))

 (defn token-aware-policy
-  "Wrapper to add token-awareness to the underlying policy."
+  "Takes a load balancing policy and makes it token-aware"
   [^LoadBalancingPolicy underlying-policy]
   (TokenAwarePolicy. underlying-policy))

@@ -64,8 +64,7 @@

 (defn exponential-reconnection-policy
   "Reconnection policy that waits exponentially longer between each
-reconnection attempt (but keeps a constant delay once a maximum delay is
-reached).
+reconnection attempt but keeps a constant delay once a maximum delay is reached.

    Delays should be given in milliseconds"
   [base-delay-ms max-delay-ms]
@@ -73,8 +72,8 @@

 (defn constant-reconnection-policy
   "Reconnection policy that waits constantly longer between each
-reconnection attempt (but keeps a constant delay once a maximum delay is
-reached).
+reconnection attempt but keeps a constant delay once a maximum delay is
+reached.

    Delay should be given in milliseconds"
   [delay-ms]
@@ -111,19 +110,19 @@
 (def ^:dynamic *retry-policy* (retry-policy :default))

 (defmacro with-session
-  "Executes query with given session"
+  "Executes a query with the given session"
   [session & body]
   `(binding [*default-session* ~session]
      ~@body))

 (defmacro async
-  "Executes query asyncronously"
+  "Executes a query asyncronously"
   [& body]
   `(binding [*async* true]
      ~@body))

 (defmacro prepared
-  "Helper macro to execute prepared statement"
+  "Executes a prepared statement"
   [& body]
   `(binding [cql/*prepared-statement* true
              cql/*param-stack*        (atom [])]


Switch to loop / recur for part 2

Switch to loop / recur for part 2

ClojureScript doesn’t have locals clearing
and memory usage can affect perf

--- src/advent_2017/day_17.cljc
+++ src/advent_2017/day_17.cljc
@@ -12,11 +12,11 @@
   (let [[current-pos _ buffer] (nth (iterate (partial spin input) [0 1 [0]]) 2017)]
     (buffer (inc current-pos))))

-(defn spin' [step [current-pos value after-zero]]
-  (let [new-pos (inc (mod (+ current-pos step) value))]
-    [new-pos (inc value) (if (== 1 new-pos)
-                           value
-                           after-zero)]))
-
 (defn part-2 []
-  (last (nth (iterate (partial spin' input) [0 1 nil]) 50000000)))
+  (loop [current-pos 0 value 1 after-zero nil]
+    (if (== (dec value) 50000000)
+      after-zero
+      (let [new-pos (inc (mod (+ current-pos input) value))]
+        (recur new-pos (inc value) (if (== 1 new-pos)
+                                     value
+                                     after-zero))))))


Add dissoc-in helper into uxbox.util.data

--- src/uxbox/util/data.cljs
+++ src/uxbox/util/data.cljs
@@ -36,6 +36,17 @@
   [data keys]
   (persistent!
    (reduce #(dissoc! %1 %2) (transient data) keys)))
+
+(defn dissoc-in
+  [m [k & ks :as keys]]
+  (if ks
+    (if-let [nextmap (get m k)]
+      (let [newmap (dissoc-in nextmap ks)]
+        (if (seq newmap)
+          (assoc m k newmap)
+          (dissoc m k)))
+      m)
+    (dissoc m k)))

 (defn index-of
   "Return the first index when appears the `v` value


start tools.analyzer.js impl

start tools.analyzer.js impl

--- src/main/clojure/clojure/tools/analyzer/js.clj
+++ src/main/clojure/clojure/tools/analyzer/js.clj
@@ -8,8 +8,98 @@

 (ns clojure.tools.analyzer.js
   "Analyzer for clojure code, extends tools.analyzer with JS specific passes/forms"
-  (:refer-clojure :exclude [macroexpand-1 macroexpand])
+  (:refer-clojure :exclude [macroexpand-1 var?])
   (:require [clojure.tools.analyzer
              :as ana
-             :refer [analyze analyze-in-env wrapping-meta analyze-fn-method]
-             :rename {analyze -analyze}]))
+             :refer [analyze]
+             :rename {analyze -analyze}]
+            [clojure.tools.analyzer.utils :refer [resolve-var]]
+            cljs.tagged-literals)
+  (:import cljs.tagged_literals.JSValue))
+
+(def specials
+  "Set of the special forms for clojurescript"
+  (into ana/specials '#{ns deftype* defrecord* js*}))
+
+(defmulti parse
+  "Extension to tools.analyzer/-parse for CLJS special forms"
+  (fn [[op & rest] env] op))
+
+(defmethod parse :default
+  [form env]
+  (ana/-parse form env))
+
+(defn empty-env
+  "Returns an empty env map"
+  []
+  {:context    :expr
+   :locals     {}
+   :ns         'cljs.user
+   :namespaces (atom '{cljs.user {:mappings {}
+                                  :aliases  {}
+                                  :ns       'cljs.user}
+                       cljs.core {:mappings {}
+                                  :aliases  {}
+                                  :ns       'cljs.core}})})
+
+(defn desugar-host-expr [[op & expr :as form]]
+  (if (symbol? op)
+    (let [opname (name op)]
+      (cond
+
+       (= (first opname) \.)
+       (let [[target & args] expr
+             args (list* (symbol (subs opname 1)) args)]
+         (with-meta (list '. target (if (= 1 (count args))
+                                      (first args) args))
+           (meta form)))
+
+       (= (last opname) \.)
+       (with-meta (list* 'new (symbol (subs opname 0 (dec (count opname)))) expr)
+         (meta form))
+
+       :else form))
+    form))
+
+(defn macroexpand-1 [form env]
+  (if (seq? form)
+    (let [op (first form)]
+      (if (specials op)
+        form
+        (let [v (resolve-var op env)
+              clj-var (clojure.core/resolve op)]
+          (if (and clj-var
+                   (not (-> env :locals (get op)))
+                   (not v)
+                   (:macro (meta clj-var)))
+            (apply clj-var form env (rest form)) ; (m &form &env & args)
+            (desugar-host-expr form)))))
+        form))
+
+(defrecord Var [name namespace])
+
+(defn create-var
+  [sym {:keys [ns]}]
+  (->Var sym ns))
+
+(defn var? [x]
+  (instance? Var x))
+
+(declare analyze-js-value)
+(defn analyze-form
+  [form env]
+  (if (instance? JSValue form)
+    (analyze-js-value form env)
+    (ana/-analyze-form form env)))
+
+(defn analyze
+  ([form] (analyze form (empty-env) {}))
+  ([form env] (analyze form env {}))
+  ([form env opts]
+     (with-bindings (merge {#'ana/macroexpand-1 macroexpand-1
+                            #'ana/create-var    create-var
+                            #'ana/parse         parse
+                            #'ana/var?          var?
+                            #'ana/analyze-form  analyze-form}
+                           (:bindings opts))
+                    (-analyze form env))))


clearing clipboard copy

clearing clipboard copy

--- test/celestial/fixtures.clj
+++ test/celestial/fixtures.clj
@@ -32,8 +32,8 @@
   (let [clp (.getSystemClipboard (Toolkit/getDefaultToolkit))]
     (.setContents clp (StringSelection. s) nil)))

-(clipboard-copy (clojure.data.json/write-str redis-type :escape-slash false))
-(clipboard-copy (clojure.data.json/write-str redis-vc-spec :escape-slash false))
+;; (clipboard-copy (clojure.data.json/write-str redis-type :escape-slash false))
+;; (clipboard-copy (clojure.data.json/write-str redis-vc-spec :escape-slash false))

 (defn is-type? [type]
   (fn [exception]


Language option

Language option

--- src/asset_minifier/core.clj
+++ src/asset_minifier/core.clj
@@ -10,7 +10,8 @@
            [com.google.javascript.jscomp
             CompilationLevel
             CompilerOptions
-            SourceFile]))
+            SourceFile
+            CompilerOptions$LanguageMode]))

 (defn- delete-target [target]
   (let [f (file target)]
@@ -75,8 +76,12 @@
       (.setOptionsForCompilationLevel options))
   options)

-(defn- compile-js [compiler assets externs optimization]
+(defn- compile-js [compiler assets externs optimization language]
   (let [options  (-> (CompilerOptions.)
+                     (doto (.setLanguage (-> language
+                                             (name)
+                                             (.toUpperCase)
+                                             (CompilerOptions$LanguageMode/fromString))))
                      (doto (.setOutputCharset "UTF-8"))
                      (set-optimization optimization))]

@@ -96,8 +101,9 @@
    :target (.getName (file target))
    :original-size (total-size sources)})

-(defn minify-js [path target & [{:keys [quiet? externs optimization]
+(defn minify-js [path target & [{:keys [quiet? externs optimization language]
                                  :or {quiet? false
+                                      language :ecmascript3
                                       externs []
                                       optimization :simple}}]]
   (delete-target target)
@@ -109,7 +115,7 @@
         (com.google.javascript.jscomp.Compiler/setLoggingLevel Level/SEVERE))
       (let [assets   (aggregate path ".js")
             compiler (com.google.javascript.jscomp.Compiler.)
-            result   (compile-js compiler assets externs optimization)]
+            result   (compile-js compiler assets externs optimization language)]
         (with-open [wrt (writer target)]
           (.append wrt (.toSource compiler)))
         (merge result (compression-details assets (file target)))))))


Dont use meta

Dont use meta

--- src/aurora/interpreter.cljs
+++ src/aurora/interpreter.cljs
@@ -1,6 +1,11 @@
 (ns aurora.interpreter)

-(declare run-node)
+(defn run-node [node inputs actions]
+  (case (:type node)
+    :value (run-value node inputs actions)
+    :cljs (run-cljs node inputs actions)
+    :match (run-match node inputs actions)
+    :pipe (run-pipe node inputs actions)))

 (defn run-value [node inputs actions]
   (:value node))
@@ -14,52 +19,43 @@
       (aset vars id value))
     (doseq [{:keys [id inputs node]} (:nodes node)]
       (aset vars id (run-node node (map #(aget vars %) inputs) actions)))
-    (aget vars (-> node :nodes last first))))
-
-(defn run-match [node inputs actions]
-  (assert (= 1 (count inputs)))
-  (run-match-branches (:branches node) (first inputs) actions))
+    (aget vars (-> node :nodes last :id))))

 (defrecord MatchFailure [])

 (defn check [bool]
   (when-not bool (throw (MatchFailure.))))

-(defn run-match-branches [branches input actions]
-  (if-let [[{:keys [branch inputs node]} & branches] (seq branches)]
-    (try
-      (let [vars #js {}]
-        (run-match-branch branch input actions vars)
-        (run-node node (map #(aget vars %) inputs) actions))
-      (catch MatchFailure _
-        (recur branches input actions)))
-    (throw (MatchFailure.))))
+(defn run-match [node inputs actions]
+  (assert (= 1 (count inputs)))
+  (let [input (first inputs)]
+    (loop [branches (:branches node)]
+      (if-let [[{:keys [pattern inputs node]} & branches] (seq branches)]
+        (try
+          (let [vars #js {}]
+            (run-match-pattern pattern input actions vars)
+            (run-node node (map #(aget vars %) inputs) actions))
+          (catch MatchFailure _
+            (recur branches)))
+        (throw (MatchFailure.))))))

-(defn run-match-branch [branch input actions vars]
-  (when-let [var (-> branch meta :var)]
-    (aset vars var input))
+(defn run-match-pattern [pattern input actions vars]
   (cond
-   (:type branch) (check (run-node branch [input] actions))
-   (or (number? branch) (string? branch)) (check (= branch input))
-   (or (nil? branch) (sequential? branch)) (if-let [[first-branch & rest-branch] (seq branch)]
+   (= (:type pattern) :match/bind) (do (aset vars (:var pattern) input)
+                                    (run-match-pattern (:pattern pattern) input actions vars))
+   (:type pattern) (check (run-node pattern [input] actions))
+   (or (number? pattern) (string? pattern)) (check (= pattern input))
+   (or (nil? pattern) (sequential? pattern)) (if-let [[first-pattern & rest-pattern] (seq pattern)]
                                              (do (check (and (sequential? input) (seq input)))
                                                (let [[first-input & rest-input] input]
-                                                 (run-match-branch first-branch first-input actions vars)
-                                                 (run-match-branch rest-branch rest-input actions vars)))
+                                                 (run-match-pattern first-pattern first-input actions vars)
+                                                 (run-match-pattern rest-pattern rest-input actions vars)))
                                              (check (empty? input)))
-   (map? branch) (do (check (map? input))
-                   (doseq [[key val] branch]
+   (map? pattern) (do (check (map? input))
+                   (doseq [[key val] pattern]
                      (check (contains? input key))
-                     (run-match-branch val (get input key) actions vars)))
+                     (run-match-pattern val (get input key) actions vars)))
    :otherwise (assert false)))
-
-(defn run-node [node inputs actions]
-  (:type node)
-  (case (:type node)
-    :value (run-value node inputs actions)
-    :cljs (run-cljs node inputs actions)
-    :match (run-match node inputs actions)
-    :pipe (run-pipe node inputs actions)))

 (def example-a
   {:type :pipe
@@ -69,12 +65,17 @@
            {:id "four-a-c" :inputs ["four" "a" "c"] :node {:type :cljs :fn *}}
            {:id "result" :inputs ["b-squared" "four-a-c"] :node {:type :cljs :fn -}}]})

+(defn bind [var pattern]
+  {:type :match/bind
+   :var var
+   :pattern pattern})
+
 (def example-b
   {:type :match
-   :branches [{:branch {"a" ^{:var "a"} {:type :cljs :fn number?} "b" ^{:var "b"} {:type :cljs :fn number?}}
+   :branches [{:pattern {"a" (bind "a" {:type :cljs :fn number?}) "b" (bind "b" {:type :cljs :fn number?})}
                :inputs ["a" "b"]
                :node {:type :cljs :fn -}}
-              {:branch [^{:var "x"} {:type :value :value true} "foo"]
+              {:pattern [(bind "x" {:type :value :value true}) "foo"]
                :inputs ["x" "y"]
                :node {:type :cljs :fn identity}}]})


Add list program test

Add list program test

--- test/jest/programs_test.clj
+++ test/jest/programs_test.clj
@@ -1,11 +1,16 @@
 (ns jest.programs-test
-  (:require [clojure.test :refer :all]))
+  (:require [clojure.test :refer :all]
+            [jest.utils :refer :all]))

-(import 'jest.grammar.JestParser)
-(import 'jest.grammar.JestCompiler)
+(deftest print-test
+  (let [program (slurp "resources/print.jst")]
+    (test-code
+     program
+     ["(def x 10)" "(def y 20)" "(println x)" "(println y)"])))

-(deftest func-resource-test-jst-test
-  (let [program (slurp "resources/print.jst")
-        code (. JestCompiler (getCode program))]
-    (is (= code ["(def x 10)" "(def y 20)" "(println x)" "(println y)"]))))
+(deftest list-test
+  (let [program (slurp "resources/list.jst")]
+    (test-code
+     program
+     ["(def list [1, 2, 3])" "(println list)" "(println (first list))"])))


test fix

test fix

--- test/metabase/test_data.clj
+++ test/metabase/test_data.clj
@@ -143,7 +143,7 @@
         (catch ApiException e
           (if-not (= (.getStatusCode e) 401) (throw e)
                   ;; If we got a 401 unauthenticated clear the tokens cache + recur
-                  (do (reset! user-credentials-tokens {})
+                  (do (reset! tokens {})
                       (apply call-client args))))))))

 (defn user->org-perm


More cleanup.

More cleanup.

--- test/minijava/test_tree.clj
+++ test/minijava/test_tree.clj
@@ -1,61 +1,56 @@
 (ns minijava.test-tree
   (:use clojure.test
-        (minijava ast label tree utility))
-  (:require [minijava.ir :as ir]))
-
-(import-ast-classes)
+        (minijava ast label ir tree utility)))

 (deftest tests-binop-conv
-  (let [plus  (parse-exp "5 + 5")
-        minus (parse-exp "5 - 5")
-        times (parse-exp "5 * 5")
-        and   (parse-exp "5 && 5")
-        less-than (parse-exp "5 < 5")
-        matches (fn [op ast] (= (ir/BinaryOp op (ir/Const 5) (ir/Const 5))
+  (let [plus   (parse-exp "5 + 5")
+        minus  (parse-exp "5 - 5")
+        times  (parse-exp "5 * 5")
+        and    (parse-exp "5 && 5")
+        l-than (parse-exp "5 < 5")
+        matches (fn [op ast] (= (BinaryOp op (Const 5) (Const 5))
                                 (tree ast)))]
     (dorun
      (map #(is (matches %1 %2) "AST converts to BinaryOp IR.")
-          [:+   :-    :*    :&&  :<]
-          [plus minus times and less-than]))))
+          [:+   :-    :*    :&& :<]
+          [plus minus times and l-than]))))

 (deftest tests-int-bool-conv
-  (is (= (ir/Const 5) (tree (parse-exp "5"))))
-  (is (= (ir/Const 1) (tree (parse-exp "true"))))
-  (is (= (ir/Const 0) (tree (parse-exp "false")))))
+  (is (= (Const 5) (tree (parse-exp "5"))))
+  (is (= (Const 1) (tree (parse-exp "true"))))
+  (is (= (Const 0) (tree (parse-exp "false")))))

 (deftest tests-special-if
   (is (= (let [t (label)
                f (label)]
-           (ir/Seq [(ir/Conditional :< (ir/Const 3) (ir/Const 4)
-                                    (ir/Name t) (ir/Name f))
-                    (ir/Label t)
-                    (ir/Seq [])
-                    (ir/Label f)
-                    (ir/Seq [])]))
-          (tree (parse-stm "if (3 < 4) {} else {}")))
+           (Seq [(Conditional :< (Const 3) (Const 4) (Name t) (Name f))
+                 (Label t)
+                 (Seq [])
+                 (Label f)
+                 (Seq [])]))
+         (tree (parse-stm "if (3 < 4) {} else {}")))
       "If statements with boolean tests convert correctly."))

 (deftest tests-regular-if
   (is (= (let [t (label)
                f (label)]
-           (ir/Seq [(ir/Conditional :!= (ir/BinaryOp :+ (ir/Const 3) (ir/Const 4))
-                                    0 (ir/Name t) (ir/Name f))
-                    (ir/Label t)
-                    (ir/Seq [])
-                    (ir/Label f)
-                    (ir/Seq [])]))
+           (Seq [(Conditional :!= (BinaryOp :+ (Const 3) (Const 4))
+                              0 (Name t) (Name f))
+                 (Label t)
+                 (Seq [])
+                 (Label f)
+                 (Seq [])]))
          (tree (parse-stm "if (3 + 4) {} else {}")))
       "If statements that test normal expressions convert correctly."))

 (deftest tests-while
-  (is (= (let [test  (label)
-               t (label)
-               f (label)]
-           (ir/Seq [(ir/Label test)
-                    (ir/Conditional :< (ir/Const 3) (ir/Const 4)
-                                    (ir/Name t) (ir/Name f))
-                    (ir/Label t)
-                    (ir/Seq [])
-                    (ir/Jump test)
-                    (ir/Label f)])))
+  (is (= (let [test (label)
+               t    (label)
+               f    (label)]
+           (Seq [(Label test)
+                 (Conditional :< (Const 3) (Const 4) (Name t) (Name f))
+                 (Label t)
+                 (Seq [])
+                 (Jump test)
+                 (Label f)])))
       "While statements convert correctly."))


Fix URL extraction for uploads with new, merged servers

--- src/braid/uploads/core.cljc
+++ src/braid/uploads/core.cljc
@@ -214,7 +214,7 @@
             ;; currently, it is possible for a user in another group to access a file
             ;; IF they know its path (which, is behind a UUID, so, non-trivial to guess/enumerate)
             (let [expires-seconds (* 1 24 60 60) ; one day
-                  asset-key (URLDecoder/decode (second (re-matches #"^/upload/(.*)" (request :uri))))]
+                  asset-key (URLDecoder/decode (second (re-matches #"^/api/upload/(.*)" (request :uri))))]
               {:status 302
                :headers {"Cache-Control" (str "private, max-age=" expires-seconds)
                          "Location" (s3/readable-s3-url config expires-seconds asset-key)}}))])


loading defmethod

loading defmethod

--- src/celestial/workflows.clj
+++ src/celestial/workflows.clj
@@ -16,9 +16,11 @@
     [clojure.core.strint :only (<<)]
     [slingshot.slingshot :only  [throw+ try+]]
     [celestial.model :only (vconstruct pconstruct rconstruct)])
-  (:require ; loading defmethods
+  (:require
+    ; loading defmethods
     proxmox.provider
     freenas.provider
+    digital.provider
     aws.provider
     vc.provider
     physical.provider


check settings before allowing public register

--- src/chat/server/handler.clj
+++ src/chat/server/handler.clj
@@ -46,29 +46,31 @@
                    slurp)]
       (string/replace html #"\{\{\w*\}\}" replacements)))

-  ; TODO: verify that this is a group that you are allowed to join without an invite
   (POST "/public-register/:group-id" [group-id email :as req]
-    (if (string/blank? email)
-      {:status 400 :body "Invalid email"}
-      (let [group-id (java.util.UUID/fromString group-id)
-            id (db/uuid)
-            avatar (identicons/id->identicon-data-url id)
-            ; XXX: copied from chat.shared.util/nickname-rd
-            disallowed-chars #"[ \t\n\]\[!\"#$%&'()*+,.:;<=>?@\^`{|}~/]"
-            nick (-> (first (string/split email #"@"))
-                     (string/replace disallowed-chars ""))
-            u (db/with-conn (db/create-user! {:id id
-                                              :email email
-                                              :password (random-nonce 50)
-                                              :avatar avatar
-                                              :nickname nick}))]
-        (db/with-conn
-          (db/user-add-to-group! id group-id)
-          (db/user-subscribe-to-group-tags! id group-id))
-        (sync/broadcast-user-change id [:chat/new-user u])
-        {:status 302 :headers {"Location" "/"}
-         :session (assoc (req :session) :user-id id)
-         :body ""})))
+    (let [group-id (java.util.UUID/fromString group-id)
+          group-settings (db/with-conn (db/group-settings group-id))]
+      (if-not (get group-settings :public?)
+        {:status 400 :body "No such group or the group is private"}
+        (if (string/blank? email)
+          {:status 400 :body "Invalid email"}
+          (let [id (db/uuid)
+                avatar (identicons/id->identicon-data-url id)
+                ; XXX: copied from chat.shared.util/nickname-rd
+                disallowed-chars #"[ \t\n\]\[!\"#$%&'()*+,.:;<=>?@\^`{|}~/]"
+                nick (-> (first (string/split email #"@"))
+                         (string/replace disallowed-chars ""))
+                u (db/with-conn (db/create-user! {:id id
+                                                  :email email
+                                                  :password (random-nonce 50)
+                                                  :avatar avatar
+                                                  :nickname nick}))]
+            (db/with-conn
+              (db/user-add-to-group! id group-id)
+              (db/user-subscribe-to-group-tags! id group-id))
+            (sync/broadcast-user-change id [:chat/new-user u])
+            {:status 302 :headers {"Location" "/"}
+             :session (assoc (req :session) :user-id id)
+             :body ""})))))

   (POST "/register" [token invite_id password email now hmac nickname avatar :as req]
     (let [fail {:status 400 :headers {"Content-Type" "text/plain"}}]


disable moves based on configuration

disable moves based on configuration

--- src/chessground/render.cljs
+++ src/chessground/render.cljs
@@ -13,20 +13,22 @@

 (q/defcomponent Piece
   "A piece in a square"
-  [{color :color role :role} channels]
-  (drag/make channels
-             (d/div {:className (class-name #{"piece" (name color) (name role)})})))
+  [[{color :color role :role} movable] channels]
+  (let [piece (d/div {:className (class-name #{"piece" (name color) (name role)})})]
+    (if movable (drag/make channels piece) piece)))

 (q/defcomponent Square
   "One of the 64 board squares"
   [state key channels]
-  (d/div {:className (class-name #{"square"
-                                   (when (= (:selected state) key) "selected")})
-          :key (name key) ; react.js key just in case it helps performance
-          :data-key (name key)
-          :onClick #(push! (:select-square channels) key)}
-         (when-let [piece (chess/get-piece (:chess state) key)]
-           (Piece piece channels))))
+  (let [attributes {:className (class-name #{"square"
+                                             (when (= (:selected state) key) "selected")})
+                    :key (name key) ; react.js key just in case it helps performance
+                    :data-key (name key)}
+        movable (-> state :movable :enabled)
+        behaviors (when movable {:onClick #(push! (:select-square channels) key)})]
+    (d/div (merge attributes behaviors)
+           (when-let [piece (chess/get-piece (:chess state) key)]
+             (Piece [piece movable] channels)))))

 (q/defcomponent Board
   "The whole board"


require migae.datastore.Interfaces

require migae.datastore.Interfaces

--- src/clj/migae/datastore.clj
+++ src/clj/migae/datastore.clj
@@ -39,6 +39,7 @@
   (:require [clojure.walk :as walk]
             [clojure.stacktrace :refer [print-stack-trace]]
             [clojure.tools.reader.edn :as edn]
+            [migae.datastore.Interfaces]
             [migae.datastore.types.entity-map]
             [migae.datastore.types.entity-map-seq]
             ;; [migae.datastore.structure.vector]


Don't use upper and lower case in env id

--- src/clj/retroboard/util.clj
+++ src/clj/retroboard/util.clj
@@ -2,7 +2,6 @@

 (def valid-chars
   (map char (concat (range 48 58)
-                    (range 65 91)
                     (range 97 123))))

 (defn rand-char []
@@ -10,15 +9,3 @@

 (defn rand-str [len]
   (apply str (take len (repeatedly rand-char))))
-
-(defn unique-str [len strs]
-  (-> strs
-      (remove (repeatedly #(rand-str len)))
-      first))
-
-(defn unique-str-generator [len]
-  (let [used-strs (atom #{})]
-    (fn []
-      (let [new-str (unique-str len @used-strs)]
-        (swap! used-strs conj new-str)
-        new-str))))


Parse meta info line with more than one string fields correctly

--- src/cljam/io/vcf/reader.clj
+++ src/cljam/io/vcf/reader.clj
@@ -60,12 +60,12 @@
   (= (subs line 0 2) "##"))

 (defn- parse-structured-line
-  "e.g. (parse-structured-line \"ID=NS,Number=1,Type=Integer,Description=\"Number of Samples With Data\"\")
+  "e.g. (parse-structured-line \"ID=NS,Number=1,Type=Integer,Description=\\\"Number of Samples With Data\\\"\")
         => {:id \"NS\" :number \"1\" :type \"Integer\"
             :description \"Number of Samples With Data\"}"
   [s]
-  (->> (re-seq #"([\w:/\.\?\-]*)=((?:\"(.*)\")|([\w:/\.\?\-]*))" s)
-       (map (fn [[_ k v1 v2 _]]
+  (->> (re-seq #"([\w:/\.\?\-]*)=(?:(?:\"([^\"]*?)\")|([\w:/\.\?\-]*))" s)
+       (map (fn [[_ k v1 v2]]
               {(->kebab-case-keyword k) (dot->nil (or v2 v1))}))
        (apply merge)))


add more history and unported sections, and make sure to remove previous docset builds first

--- src/cljs_api_gen/docset.clj
+++ src/cljs_api_gen/docset.clj
@@ -5,7 +5,7 @@
     [cljs-api-gen.write :refer [get-last-written-result]]
     [cljs-api-gen.encode :refer [decode-fullname]]
     [clojure.java.jdbc :as j]
-    [me.raynes.fs :refer [copy copy-dir list-dir base-name mkdirs]]
+    [me.raynes.fs :refer [delete-dir copy copy-dir list-dir base-name mkdirs]]
     ))

 ;; NOTE: you have to run docset/run-all.sh first to download/process the
@@ -45,6 +45,8 @@
                     (-> result :compiler-api :symbols))
         namespaces (set (map :ns (vals syms)))]

+    (delete-dir docset-path)
+
     (mkdirs docset-docs-path)

     ;; copy over offline pages
@@ -60,10 +62,16 @@
        "CREATE TABLE searchIndex(id INTEGER PRIMARY KEY, name TEXT, type TEXT, path TEXT)"
        "CREATE UNIQUE INDEX anchor ON searchIndex (name, type, path)")

-    ;; insert sections
     (j/insert! sqlite-db :searchIndex
-       {:name "Library API"  :type "Section" :path (resolve-path "README.html#library-api-reference")}
-       {:name "Compiler API" :type "Section" :path (resolve-path "README.html#compiler-api-reference")})
+       ;; insert categories
+       {:name "Library API"  :type "Category" :path (resolve-path "README.html#library-api-reference")}
+       {:name "Compiler API" :type "Category" :path (resolve-path "README.html#compiler-api-reference")}
+
+       ;; insert sections
+       {:name "Overview"                :type "Section" :path (resolve-path "README.html")}
+       {:name "History"                 :type "Section" :path (resolve-path "HISTORY.html")}
+       {:name "Not Ported From Clojure" :type "Section" :path (resolve-path "UNPORTED.html")}
+       )

     ;; insert namespaces
     (apply j/insert! sqlite-db :searchIndex
@@ -74,7 +82,10 @@
     (let [refs-path (str docset-docs-path "/" (resolve-path "refs"))]
       (apply j/insert! sqlite-db :searchIndex
         (for [ref-file (list-dir refs-path)]
-          (let [encoded-name (base-name ref-file true)
+          (let [encoded-name
+                (second
+                  (re-find #"github\.com/cljsinfo/api-refs/blob/catalog/refs/(.*)\.md "
+                           (slurp ref-file)))
                 full-name (decode-fullname encoded-name)
                 item (get syms full-name)]
             {:name full-name


Added add-cn-records to add a list of conceptnet data represented as a map

--- src/conceptnet_clj/core.clj
+++ src/conceptnet_clj/core.clj
@@ -60,6 +60,14 @@
 (add-cn-data d1)
 (add-cn-data d2)

+;;
+;; add-cn-records - add a list of maps of conceptnet data
+;;
+(defn add-cn-records [records]
+  (doseq [record records] (prn record) (add-cn-data record)))
+
+(add-cn-records data)
+
 (defn find-all-concepts []
   (d/q '[:find ?concept ?surfaceStart
          :where [?eid :cnet/surfaceText ?concept]
@@ -80,5 +88,4 @@
        (d/db conn)
        concept-name))

-(pp/pprint (find-concepts-for-concept "Clojure"))
-
+(pp/pprint (find-concepts-for-concept "Clojure"))


Convert more tests from cucumber to midje for item_create.clj. Last test fails

--- test/fcms/integration/api/item/item_create.clj
+++ test/fcms/integration/api/item/item_create.clj
@@ -29,12 +29,16 @@
 ;; slug specified in body is already used
 ;; slug specified in body is invalid

-(defn- create-item-with-api [options]
-  "Makes an API request to create the item and returns the response."
-  (api-request :post "/e/" {:headers
-                            {:Accept (mime-type :item)
-                             :Content-Type (mime-type :item)}
-                            :body options}))
+(defn- create-item-with-api
+  "Makes an API request to create the item and returns the response."
+  ([body]
+     (api-request :post "/e/" {:headers
+                                {:Accept (mime-type :item)
+                                 :Content-Type (mime-type :item)}
+                                :body body}))
+  ([headers body]
+     (api-request :post "/e/" {:headers headers
+                                :body body})))

 (with-state-changes [(before :facts (empty-collection-e))
                      (after :facts (collection/delete-collection e))]
@@ -168,4 +172,122 @@
         (response-mime-type response) => (mime-type :text)
         (let [body (body-from-response response)]
           (.contains body "A reserved property was used.") => true)
+        (collection/item-count e) => 0)
+      ;; conflicts with collection property
+      (let [response (create-item-with-api {:name i :collection "foo"})]
+        (:status response) => 422
+        (response-mime-type response) => (mime-type :text)
+        (let [body (body-from-response response)]
+          (.contains body "A reserved property was used.") => true)
+        (collection/item-count e) => 0)
+      ;; conflicts with id property
+      (let [response (create-item-with-api {:name i :id "foo"})]
+        (:status response) => 422
+        (response-mime-type response) => (mime-type :text)
+        (let [body (body-from-response response)]
+          (.contains body "A reserved property was used.") => true)
+        (collection/item-count e) => 0)
+      ;; conflicts with type property
+      (let [response (create-item-with-api {:name i :type "foo"})]
+        (:status response) => 422
+        (response-mime-type response) => (mime-type :text)
+        (let [body (body-from-response response)]
+          (.contains body "A reserved property was used.") => true)
+        (collection/item-count e) => 0)
+      ;; conflicts with created-at property
+      (let [response (create-item-with-api {:name i :created-at "foo"})]
+        (:status response) => 422
+        (response-mime-type response) => (mime-type :text)
+        (let [body (body-from-response response)]
+          (.contains body "A reserved property was used.") => true)
+        (collection/item-count e) => 0)
+      ;; conflicts with updated-at property
+      (let [response (create-item-with-api {:name i :updated-at "foo"})]
+        (:status response) => 422
+        (response-mime-type response) => (mime-type :text)
+        (let [body (body-from-response response)]
+          (.contains body "A reserved property was used.") => true)
+        (collection/item-count e) => 0)
+      ;; check if collection is still empty
+      (let [response (api-request :get "/e/i" {
+        :headers {
+          :Accept (mime-type :item)
+        }})]
+        (:status response) => 404
+        (body? response) => false))
+
+    ;; no accept type - 201 Created
+    ;; curl -i --header "Accept-Charset: utf-8" --header "Content-Type: application/vnd.fcms.item+json;version=1" -X POST -d '{"name":"i"}' http://localhost:3000/c/
+    (fact "creating an item without an Accept header"
+      (let [response (create-item-with-api
+                       {:Content-Type (mime-type :item)}
+                       {:name i})]
+        (:status response) => 201
+        (response-mime-type response) => (mime-type :item)
+        (response-location response) => "/e/i"
+        (json? response) => true
+        ;; Get the created item and make sure it's right
+        (item/get-item e i) => (contains
+                                 {:collection e
+                                   :name i
+                                   :slug i
+                                   :version 1})
+        (collection/item-count e) => 1))
+
+    ;; wrong accept type - 406 Not Acceptable
+    ;; curl -i --header "Accept: application/vnd.fcms.collection+json;version=1" --header "Accept-Charset: utf-8" --header "Content-Type: application/vnd.fcms.item+json;version=1" -X POST -d '{"name":"i"}' http://localhost:3000/c/
+    (fact "creating an item with wrong Accept header"
+      (let [response (create-item-with-api
+                       {:Accept (mime-type :collection)
+                        :Content-Type (mime-type :item)}
+                       {:name i})]
+        (:status response) => 406
+        (response-mime-type response) => (mime-type :text)
+        (response-location response) => nil
+        (let [body (body-from-response response)]
+          (.contains body "Acceptable media type: application/vnd.fcms.item+json;version=1") => true
+          (.contains body "Acceptable charset: utf-8") => true)
+        (collection/item-count e) => 0
+        ;; Get the created item and make sure it's right
+        (let [response (api-request :get "/e/i" {:headers
+                                                  {:Accept (mime-type :item)}})]
+          (:status response) => 404
+          (body? response) => false)))
+
+    ;; no content type - 201 Created
+    ;; curl -i --header "Accept: application/vnd.fcms.item+json;version=1" --header "Accept-Charset: utf-8" -X POST -d '{"name":"i"}' http://localhost:3000/c/
+    (fact "create an item without a Content-Type header"
+      (let [response (create-item-with-api
+                       {:Accept (mime-type :item)}
+                       {:name i})]
+        (:status response) => 201
+        (response-mime-type response) => (mime-type :item)
+        (response-location response) => "/e/i"
+        (json? response) => true
+        ;; Get the created item and make sure it's right
+        (item/get-item e i) => (contains
+                                 {:collection e
+                                   :name i
+                                   :slug i
+                                   :version 1})
+        (collection/item-count e) => 1))
+
+    ;; wrong content type - 415 Unsupported Media Type
+    ;; curl -i --header "Accept: application/vnd.fcms.item+json;version=1" --header "Accept-Charset: utf-8" --header "Content-Type: application/vnd.fcms.collection+json;version=1" -X POST -d '{"name":"i"}' http://localhost:3000/c/
+    (fact "create an item with the wrong Content-Type header"
+      (let [response (create-item-with-api
+                       {:Accept (mime-type :item)
+                        :Content-Type (mime-type :collection)}
+                       {:name i})]
+        (:status response) => 415
+        (response-mime-type response) => (mime-type :text)
+        (response-location response) => nil
+        (let [body (body-from-response response)]
+          (.contains body "Acceptable media type: application/vnd.fcms.item+json;version=1") => true
+          (.contains body "Acceptable charset: utf-8") => true)
+        ;; Get the created item and make sure it's right
+        (let [response (api-request :get "/e/i" {:headers
+                                                  {:Accept (mime-type :item)}})]
+          (:status response) => 404
+          (body? response) => false)
         (collection/item-count e) => 0))))


Fixed subcontext?

Fixed subcontext?

... always making the most stupid mistakes in the simplest functions.

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

--- src/conexp/fca/contexts.clj
+++ src/conexp/fca/contexts.clj
@@ -532,8 +532,16 @@
 (defn subcontext?
   "Tests whether ctx-1 is a subcontext ctx-2 or not."
   [ctx-1 ctx-2]
-  (and (subset? (objects ctx-1) (objects ctx-2))
-       (subset? (attributes ctx-1) (attributes ctx-2))))
+  (let [objs-1 (objects ctx-1)
+	objs-2 (objects ctx-2)
+	atts-1 (attributes ctx-1)
+	atts-2 (attributes ctx-2)]
+    (and (subset? objs-1 objs-2)
+	 (subset? atts-1 atts-2)
+	 (forall [[g m] (incidence ctx-1)]
+	   (=> (and (contains? objs-1 g)
+		    (contains? atts-1 m))
+	       (contains? (incidence ctx-2) [g m]))))))

 (defn compatible-subcontext?
   "Tests whether ctx-1 is a compatible subcontext of ctx-2."


Fixed Jia's last name to be He not Le on the team page

--- src-cljs/frontend/components/about.cljs
+++ src-cljs/frontend/components/about.cljs
@@ -200,7 +200,7 @@
     :github ""
     :email ""
     :bio "One of the few surviving San Francisco natives, Chris recently graduated from the University of California, Irvine with a degree in Classical Civilization. Quickly realizing that Latin was a dead language and having a passion for computers and technology, he began working at CircleCI, where he is excited to develop and expand his DevOps knowledge."}
-   {:name "Jia Le"
+   {:name "Jia He"
     :img-path (scaled-image-path "jia")
     :role "Account Manager"
     :github ""


Remove unused scrollbar width value

Remove unused scrollbar width value

Not clear what it was for, but it's not used anymore.

--- src-cljs/frontend/components/aside.cljs
+++ src-cljs/frontend/components/aside.cljs
@@ -447,8 +447,6 @@
 (defn aside-menu [app owner]
   (reify
     om/IDisplayName (display-name [_] "Aside Menu")
-    om/IInitState (init-state [_] {:scrollbar-width 0})
-    om/IDidMount (did-mount [_] (om/set-state! owner :scrollbar-width (goog.style/getScrollbarWidth)))
     om/IRender
     (render [_]
       (html
@@ -457,7 +455,7 @@
         (om/build org-settings-menu app)
         (om/build admin-settings-menu app)
         (om/build account-settings-menu app)
-        (om/build branch-activity-list app {:opts {:scrollbar-width (om/get-state owner :scrollbar-width)}})]))))
+        (om/build branch-activity-list app)]))))

 (defn- aside-nav-clicked
   [owner event-name]


Add error alert icon for v2

Add error alert icon for v2

--- src-cljs/frontend/components/build.cljs
+++ src-cljs/frontend/components/build.cljs
@@ -47,7 +47,9 @@
   (let [build-id (build-model/id build)
         build-url (:build_url build)]
     (when (:failed build)
-      [:div.alert.alert-danger
+      [:div.alert.alert-danger.iconified
+       (when (feature/enabled? :ui-v2)
+         [:div [:img.alert-icon {:src (common/icon-path "Info-Error")}]])
        (if (:infrastructure_fail build)
          (infrastructure-fail-message owner)
          [:div.alert-wrap


when-map: add a few more tests

when-map: add a few more tests

--- src/storaged/test/leela/storaged/network/actions/common_test.clj
+++ src/storaged/test/leela/storaged/network/actions/common_test.clj
@@ -4,8 +4,26 @@
    [slingshot.slingshot :refer [try+]]
    [leela.storaged.network.actions.common :refer :all]))

-(deftest test-when-map
-  (is (try+
-       (when-map {:foobar integer?} {"foobar" 10} false)
-       (catch [:type :leela.storaged/user-error] _
-         true))))
+(deftest test-when-map-ok
+  (is (when-map {:foo keyword?} {:foo :bar} true)))
+
+(deftest test-when-map-type-fails
+  (is
+   (try+
+    (when-map {:foo integer?} {:foo :bar} false)
+    (catch [:type :leela.storaged/user-error] _
+      true))))
+
+(deftest test-when-map-key-missing
+  (is
+   (try+
+    (when-map {:foo (constantly true)} {:bar :foo} false)
+    (catch [:type :leela.storaged/user-error] _
+      true))))
+
+(deftest test-when-map-fun-missing
+  (is
+   (try+
+    (when-map {} {:foo :bar} false)
+    (catch [:type :leela.storaged/user-error] _
+      true))))


Always re-read descriptor/jar path on activate

--- src/containium/commands.clj
+++ src/containium/commands.clj
@@ -93,6 +93,9 @@
     (logging/done command-logger)))

+(def path-cache (atom {}))
+
+
 (defmethod handle-command "module"
   [_ args systems command-logger]
   (let [[action name path] args]
@@ -103,7 +106,9 @@
                (logging/done command-logger))

       "activate" (if name
-                   (let [descriptor (when path (modules/module-descriptor (as-file path)))]
+                   (let [path (or path (get @path-cache name))
+                         descriptor (when path (modules/module-descriptor (as-file path)))]
+                     (swap! path-cache assoc name path)
                      (modules/activate! (:modules systems) name descriptor command-logger))
                    (do (error-command command-logger "Missing name argument.")
                        (logging/done command-logger)))


add tx/session-id to schema

add tx/session-id to schema

--- src/dato/datomic/schema.clj
+++ src/dato/datomic/schema.clj
@@ -26,7 +26,8 @@
    ;; Universal attributes
   [(attribute :migration/version :db.type/long)
    (attribute :dato/guid :db.type/uuid :db/unique :db.unique/identity)
-   (attribute :tx/guid :db.type/uuid :db/unique :db.unique/identity)])
+   (attribute :tx/guid :db.type/uuid :db/unique :db.unique/identity)
+   (attribute :tx/session-id :db.type/string)])

 (def schema-2
   (vec


Use another click-handler

Use another click-handler

--- src/discuss/references.cljs
+++ src/discuss/references.cljs
@@ -65,7 +65,7 @@
             author (:author data)]
         (dom/div #js {:className "bs-callout bs-callout-info"}
                  (dom/a #js {:href    "javascript:void(0)"
-                             :onClick #(com/ajax-get (:url statement))}
+                             :onClick #(com/ajax-get-and-change-view (:url statement) :default)}
                         (dom/strong nil (:text statement)))
                  (dom/div nil "Issue: " (:title issue))
                  (dom/div nil "Author: " (:nickname author)))))))
@@ -77,6 +77,5 @@
     (render [_]
       (let [usages (get-reference-usages-from-app-state)]
         (dom/div nil
-                 (dom/h6 nil (str "Received " (count usages) " usage(s)."))
                  (apply dom/div nil
                         (map #(om/build usage-view (lib/merge-react-key %)) usages)))))))


Trying a shutdown hook to terminate the scheduling pool

--- src/elefant_server/boot.clj
+++ src/elefant_server/boot.clj
@@ -14,4 +14,5 @@
     (run-jetty-async site-and-api {:port port :join? false}))
   )
 (defn -main [& [port]]
+  (.addShutdownHook (Runtime/getRuntime) (Thread. #(.shutdown schejulure.core/pool)))
   (start-server port))


more documentation

more documentation

--- src/bolth.clj
+++ src/bolth.clj
@@ -208,7 +208,8 @@
   Available options:
   :show-slow-tests : an boolean (default is false)

-  tracks individual test runtimes and reports the slowest N tests (where N is specified by the option :slow-test-count, defaults to 10)
+  tracks individual test runtimes and reports the slowest N tests (where N is specified by the option :slow-test-count, defaults to 10).
+  Note that if any tests fail, the slow tests won't be shown (because you should fix the tests before optimizing test runtime).

   :slow-test-count : an positive number (default is 10)


Fix fn name collision in tests

Fix fn name collision in tests

--- test/tick/interval_test.clj
+++ test/tick/interval_test.clj
@@ -78,7 +78,7 @@
 ;; concur is really the complement to disjoint, but we'll test it
 ;; anywhere to ensure the complement function is working as expected.

-(deftest concur-test []
+(deftest concur?-test []
   (is (nil?
        (concur?
         [(instants 0) (instants 1)]


Fixed wrong param type, published conversion and validation functions.

--- src/fm/simrunner/config.clj
+++ src/fm/simrunner/config.clj
@@ -16,6 +16,16 @@
   (try
     (Double/valueOf (str string))
     (catch NumberFormatException x)))
+
+(defn- string->boolean [^String string]
+  (let [string (-> string str .trim)]
+    (cond
+      (= "1" string) true
+      (= "0" string) false
+      :else nil)))
+
+(defn- boolean? [value]
+  (instance? Boolean value))

 (def ^{:private true} parameter-ids [:input-file
                                      :eps
@@ -38,24 +48,25 @@
                                         :string->value string->double}
                                        {:valid?        number?
                                         :string->value string->double}
-                                       {:valid?        number?
-                                        :string->value string->double}
+                                       {:valid?        boolean?
+                                        :string->value string->boolean}
                                        {:valid?        number?
                                         :string->value string->double}])

 (def ^{:private true} parameter-defs (zipmap parameter-ids parameter-specs))
-
-(defn- string->value [param-id value-string]
+
+(defn- throw-undefined-param-id [id]
+  (throw (IllegalArgumentException. (format "Undefined parameter id: %s!" id))))
+
+(defn string->value [param-id value-string]
   (if-let [string->value (get-in parameter-defs [param-id :string->value])]
     (string->value value-string)
-    (throw (IllegalArgumentException. (format "Undefined parameter id: %s!"
-                                              param-id)))))
+    (throw-undefined-param-id param-id)))

-(defn- value-valid? [param-id value]
+(defn value-valid? [param-id value]
   (if-let [valid? (get-in parameter-defs [param-id :valid?])]
     (valid? value)
-    (throw (IllegalArgumentException. (format "Undefined parameter id: %s!"
-                                              param-id)))))
+    (throw-undefined-param-id param-id)))

 (defn- blank? [trimmed-line]
   (.isEmpty trimmed-line))


Reject configs with missing or empty values.

--- src/fm/simrunner/config.clj
+++ src/fm/simrunner/config.clj
@@ -106,5 +106,9 @@
 (defn write-config-file [config file]
   (with-open [writer (jio/writer file)]
     (doseq [value (map #(str (get config %)) param-ids)]
-      (doto writer (.write value) .newLine))))
+      (if (.isEmpty value)
+        (throw (IllegalArgumentException. "Missing or empty value in config!"))
+        (doto writer
+          (.write value)
+          .newLine)))))


Added licence notice

Added licence notice

--- src/freecoin/views/tags.clj
+++ src/freecoin/views/tags.clj
@@ -1,3 +1,27 @@
+;; Freecoin - digital social currency toolkit
+
+;; part of Decentralized Citizen Engagement Technologies (D-CENT)
+;; R&D funded by the European Commission (FP7/CAPS 610349)
+
+;; Copyright (C) 2016 Dyne.org foundation
+
+;; Sourcecode designed, written and maintained by
+;; Denis Roio <jaromil@dyne.org>
+;; Carlo Sciolla <carlo.sciolla@gmail.com>
+
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU Affero General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU Affero General Public License for more details.
+
+;; You should have received a copy of the GNU Affero General Public License
+;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
 (ns freecoin.views.tags)

 (defn build-html [tags]


Add frequency ratios

Add frequency ratios

--- src/fugue/midi_monitor.cljs
+++ src/fugue/midi_monitor.cljs
@@ -1,5 +1,7 @@
 (ns fugue.midi-monitor
   (:require [reagent.core :as r]
+            [goog.string :refer [format]]
+            [goog.string.format]
             [cljs.core.async :as async]
             [fugue.cof :refer [cof]]
             [fugue.midi :as midi]
@@ -27,11 +29,28 @@
 (defn sanitize [notes]
   (sort (into #{} (map #(mod % 12) notes))))

+(defn ratios [notes]
+  (let [freqs (map midi/note->hz (sort notes))]
+    (for [x freqs y freqs]
+      (/ x y))))
+
+(defn other-thing [notes]
+  (let [freqs (map midi/note->hz (sort notes))]
+    (for [x freqs y freqs]
+      (- y x))))
+
 (defn note-monitor-view [notes]
   [:div
    [cof notes]
    [:p (str (sanitize notes))]
    [:p (str (sort (map (comp int midi/note->hz) notes)))]
+   [:ul
+    (for [ratio (into #{} (ratios notes))]
+      [:li (format "%.2f" ratio)])]
+   [:ul
+    (for [ratio (into #{} (other-thing notes))]
+      [:li (format "%.2f" ratio)])]
+   [:hr]
    [:ul
     (for [chord (chords/possible-chords notes)]
       [:li (str chord)])]


make sure we get channel names for multicamera

git-svn-id: 03a8048b5ee8463be5048a3801110fb50f378627@8784 d0ab736e-dc22-4aeb-8dc9-08def0aa14fd

--- acqEngine/src/org/micromanager/acq_engine.clj
+++ acqEngine/src/org/micromanager/acq_engine.clj
@@ -99,6 +99,20 @@
     (+ (core-time-from-tags tags)
        (:burst-time-offset state))))

+;; channels
+
+(defn get-camera-channel-names []
+  (vec (map #(core getCameraChannelName %)
+       (range (core getNumberOfCameraChannels)))))
+
+(defn super-channel-name [simple-channel-name camera-channel-name]
+  (if (>= 1 (core getNumberOfCameraChannels))
+    simple-channel-name
+    (if (or (empty? simple-channel-name)
+            (= "Default" simple-channel-name))
+      camera-channel-name
+      (str simple-channel-name "-" camera-channel-name))))
+
 ;; image metadata

 (defn generate-metadata [event state]
@@ -334,33 +348,36 @@
   (let [burst-events (assign-z-offsets (event :burst-data))
         camera-index (str (core getCameraDevice) "-CameraChannelIndex")
         camera-channel-count (core getNumberOfCameraChannels)
-        bursts-per-camera-channel (vec (repeat camera-channel-count burst-events))]
+        bursts-per-camera-channel (vec (repeat camera-channel-count burst-events))
+        camera-channel-names (get-camera-channel-names)]
     (doall
       (loop [burst-seqs bursts-per-camera-channel i 0]
         (check-for-serious-error)
         (when (and (not (@state :stop))
-                 (not (apply = nil burst-seqs))
-                 (or (pos? (core getRemainingImageCount))
-                     (core isSequenceRunning)))
+                   (not (apply = nil burst-seqs))
+                   (or (pos? (core getRemainingImageCount))
+                       (core isSequenceRunning)))
+          (when (and (not (@state :stop))
+                     (core isBufferOverflowed))
+            (swap! state assoc
+                   :stop true
+                   :circular-buffer-overflow true))
           (let [image (pop-burst-image)
                 cam-chan (if-let [cam-chan-str (get-in image [:tags camera-index])]
                            (Long/parseLong cam-chan-str)
                            0)
-                event (first (burst-seqs cam-chan))]
-            (println i ": " cam-chan ": " event)
+                camera-channel-name (nth camera-channel-names cam-chan)
+                event (first (burst-seqs cam-chan))
+                event+ (-> event
+                           (update-in [:channel-index] make-multicamera-channel cam-chan)
+                           (update-in [:channel :name] super-channel-name camera-channel-name))]
             (when (zero? i)
               (swap! state assoc
                      :burst-time-offset (- (elapsed-time @state)
                                            (core-time-from-tags (image :tags)))))
-            (when (and (not (@state :stop))
-                       (core isBufferOverflowed))
-              (swap! state assoc
-                     :stop true
-                     :circular-buffer-overflow true))
-            (let [event+ (update-in event [:channel-index] make-multicamera-channel cam-chan)]
-              (.put out-queue (make-TaggedImage (annotate-image image event+ @state
-                                                                (burst-time (:tags image) @state))))
-              (recur (update-in burst-seqs [cam-chan] next) (inc i))))))))
+            (.put out-queue (make-TaggedImage (annotate-image image event+ @state
+                                                              (burst-time (:tags image) @state))))
+            (recur (update-in burst-seqs [cam-chan] next) (inc i)))))))
   (burst-cleanup)) ;; burst is done!

 (defn collect-snap-image [event out-queue]
@@ -635,29 +652,20 @@
       (set-property default-cam)
       (get {1 1 , 4 3} n))))

-(defn get-camera-channel-names []
-  (map #(core getCameraChannelName %)
-       (range (core getNumberOfCameraChannels))))
-
+
 (defn super-channels [simple-channel camera-channel-names]
   (if (< 1 (count camera-channel-names))
-    (map #(update-in simple-channel [:name] str "-" %) camera-channel-names)
+    (map #(update-in simple-channel [:name] super-channel-name %) camera-channel-names)
     simple-channel))

 (defn all-super-channels [simple-channels camera-channel-names]
   (flatten (map #(super-channels % camera-channel-names) simple-channels)))

-(defn channel-names [simple-channels super-channels]
+(defn channel-colors [simple-channels super-channels channel-names]
   (if (= (count simple-channels) (count super-channels))
-    (JSONArray. (map :name super-channels))
-    (JSONArray. (map #(. % substring 8) (map :name super-channels))  )))
-
-(defn channel-colors [simple-channels super-channels channel-names]
-    (if (= (count simple-channels) (count super-channels))
-      (JSONArray. (map #(.getRGB (:color %)) super-channels))
-      (JSONArray. (map #(. MMAcquisition getMultiCamDefaultChannelColor % (.getString channel-names %))
-                         (range (count super-channels))  ))))
-
+    (map #(.getRGB (:color %)) super-channels)
+    (map #(. MMAcquisition getMultiCamDefaultChannelColor % (channel-names %))
+         (range (count super-channels)))))

 (defn make-summary-metadata [settings]
   (let [depth (core getBytesPerPixel)
@@ -665,12 +673,12 @@
         num-camera-channels (core getNumberOfCameraChannels)
         simple-channels (if-not (empty? channels) channels [{:name "Default" :color java.awt.Color/WHITE}])
         super-channels (all-super-channels simple-channels (get-camera-channel-names))
-        ch-names (channel-names simple-channels super-channels)]
+        ch-names (vec (map :name super-channels))]
      (JSONObject. {
       "BitDepth" (core getImageBitDepth)
       "Channels" (count super-channels)
-      "ChNames" ch-names
-      "ChColors" (channel-colors simple-channels super-channels ch-names)
+      "ChNames" (JSONArray. ch-names)
+      "ChColors" (JSONArray. (channel-colors simple-channels super-channels ch-names))
       "ChContrastMax" (JSONArray. (repeat (count super-channels) Integer/MIN_VALUE))
       "ChContrastMin" (JSONArray. (repeat (count super-channels) Integer/MAX_VALUE))
       "Comment" (:comment :settings)


deal with images coming from multichannel camera out of order

git-svn-id: 03a8048b5ee8463be5048a3801110fb50f378627@8765 d0ab736e-dc22-4aeb-8dc9-08def0aa14fd

--- acqEngine/src/org/micromanager/acq_engine.clj
+++ acqEngine/src/org/micromanager/acq_engine.clj
@@ -302,49 +302,57 @@
         tags (parse-core-metadata md)]
     {:pix pix :tags (dissoc tags "StartTime-ms")}))

-(defn make-multicamera-channel [camera-channel raw-channel-index]
-  (+ camera-channel (* (core getNumberOfCameraChannels) raw-channel-index)))
+(defn make-multicamera-channel [raw-channel-index camera-channel]
+  (+ camera-channel (* (core getNumberOfCameraChannels) (or raw-channel-index 0))))

 (defn make-multicamera-events [event]
   (let [num-camera-channels (core getNumberOfCameraChannels)]
     (for [camera-channel (range num-camera-channels)]
-      (let [super-channel-index (make-multicamera-channel camera-channel (event :channel-index))]
-        (assoc event :channel-index super-channel-index
-               :camera-channel-index camera-channel)))))
-
+      (-> event
+          (update-in [:channel-index] make-multicamera-channel camera-channel)
+          (assoc :camera-channel-index camera-channel)))))
+
+(defn assign-z-offsets [burst-events]
+ (if-let [slices (second @active-slice-sequence)]
+   (map #(assoc %1 :slice %2) burst-events slices)
+   burst-events))
+
+(defn burst-cleanup []
+   (when (@state :circular-buffer-overflow)
+   (ReportingUtils/showError "Circular buffer overflowed."))
+ (while (and (not (@state :stop)) (. mmc isSequenceRunning))
+   (Thread/sleep 5)))
+
 (defn collect-burst-images [event out-queue]
   (when (first-trigger-missing?)
     (pop-burst-image)) ; drop first image if first trigger doesn't happen
   (swap! state assoc :burst-time-offset nil)
-  (let [slices (second @active-slice-sequence)
-        camera-index (str (core getCameraDevice) "-CameraChannelIndex")]
-    (doseq [event (:burst-data event)]
-      (doseq [i (range (core getNumberOfCameraChannels))]
-        (when (or (core isSequenceRunning)
-                  (pos? (core getRemainingImageCount)))
-          (let [image (pop-burst-image)
-                image+ (if-not slices
-                         image
-                         (assoc-in image [:tags "ZPositionUm"] (get slices i)))]
-            (when (zero? i)
-              (swap! state assoc
-                     :burst-time-offset (- (elapsed-time @state)
-                                           (core-time-from-tags (image :tags)))))
-            (let [cam-chan (get-in image [:tags camera-index])
-                  event+ (if cam-chan
-                           (assoc event :channel-index
-                                  (Long/parseLong cam-chan))
-                           event)]
-              (.put out-queue (make-TaggedImage (annotate-image image+ event+ @state
-                                                                (burst-time (:tags image) @state))))))
-          (when (and (not (@state :stop))
-                     (core isBufferOverflowed))
-            (swap! state assoc :stop true
-                               :circular-buffer-overflow true))))))
-  (when (@state :circular-buffer-overflow)
-    (ReportingUtils/showError "Circular buffer overflowed."))
-  (while (and (not (@state :stop)) (. mmc isSequenceRunning))
-    (Thread/sleep 5)))
+  (let [burst-events (assign-z-offsets (event :burst-data))
+        camera-index (str (core getCameraDevice) "-CameraChannelIndex")
+        camera-channel-count (core getNumberOfCameraChannels)
+        bursts-per-camera-channel (vec (repeat camera-channel-count burst-events))]
+    (doall (loop [burst-seqs bursts-per-camera-channel i 0]
+             (let [image (pop-burst-image)
+                   cam-chan (Long/parseLong (get-in image [:tags camera-index]))
+                   event (first (burst-seqs cam-chan))]
+               (when (zero? i)
+                 (swap! state assoc
+                        :burst-time-offset (- (elapsed-time @state)
+                                              (core-time-from-tags (image :tags)))))
+               (when (and (not (@state :stop))
+                          (core isBufferOverflowed))
+                 (swap! state assoc
+                        :stop true
+                        :circular-buffer-overflow true))
+               (if (and (not (@state :stop))
+                        (not (apply = nil burst-seqs))
+                        (or (pos? (core getRemainingImageCount))
+                            (core isSequenceRunning)))
+                 (let [event+ (update-in event [:channel-index] make-multicamera-channel cam-chan)]
+                   (.put out-queue (make-TaggedImage (annotate-image image event+ @state (burst-time (:tags image) @state))))
+                   (recur (update-in burst-seqs [cam-chan] next) (inc i)))
+                 nil)))))
+  (burst-cleanup)) ;; burst is done!

 (defn collect-snap-image [event out-queue]
   (let [image


deal with interaction between pauses and sleeps

git-svn-id: 03a8048b5ee8463be5048a3801110fb50f378627@6098 d0ab736e-dc22-4aeb-8dc9-08def0aa14fd

--- acqEngine/src/org/micromanager/acq_engine.clj
+++ acqEngine/src/org/micromanager/acq_engine.clj
@@ -141,6 +141,9 @@
 ;; acq-engine

+(defn await-resume []
+  (while (and (:pause @state) (not (:stop @state))) (Thread/sleep 5)))
+
 (defn interruptible-sleep [time-ms]
   (let [sleepy (CountDownLatch. 1)]
     (swap! state assoc :sleepy sleepy)
@@ -148,11 +151,13 @@

 (defn acq-sleep [interval-ms]
   (let [target-time (+ (@state :last-wake-time) interval-ms)
-        sleep-time (- target-time (clock-ms))]
-    (log-cmd (@state :last-wake-time))
-    (when (pos? sleep-time)
-      (interruptible-sleep sleep-time)
-      (swap! state assoc :last-wake-time target-time))))
+        delta (- target-time (clock-ms))]
+    (when (pos? delta)
+      (interruptible-sleep delta))
+    (await-resume)
+    (let [now (clock-ms)
+          wake-time (if (> now (+ target-time 10)) now target-time)]
+      (swap! state assoc :last-wake-time wake-time))))

 (declare device-agents)

@@ -269,8 +274,9 @@

 (defn execute [event-fns]
   (doseq [event-fn event-fns :while (not (:stop @state))]
-    (while (:pause @state) (Thread/sleep 5))
-    (event-fn)))
+    (event-fn)
+    (await-resume)
+    ))

 (defn cleanup []
   (do-when #(.update %) (:display @state))
@@ -331,6 +337,7 @@
   [[] (atom {:running false :stop false})])

 (defn -run [this settings acq-eng]
+  (def latest-acq this)
   (load-mm)
   (create-device-agents)
 	(let [out-queue (GentleLinkedBlockingQueue.)


Make circle-db-data a fn, so (last-remote-commit) is re-run on every build

--- backend/src/circle/backend/project/circle.clj
+++ backend/src/circle/backend/project/circle.clj
@@ -23,14 +23,15 @@
       yaml/parse-string))

 ;; The info we should have in the database
-(def circle-db-data {:project-name "Circle"
-                     :vcs-url "git@github.com:arohner/CircleCI.git"
-                     :vcs-revision (last-remote-commit)
-                     :aws-credentials circle.aws-credentials/AWS-access-credentials
-                     :r53-zone-id "ZBVDNEPFXWZR2"
-                     :num-nodes 1
-                     :lb-name "www"
-                     :group circle/circle-group})
+(defn circle-db-data []
+  {:project-name "Circle"
+   :vcs-url "git@github.com:arohner/CircleCI.git"
+   :vcs-revision (last-remote-commit)
+   :aws-credentials circle.aws-credentials/AWS-access-credentials
+   :r53-zone-id "ZBVDNEPFXWZR2"
+   :num-nodes 1
+   :lb-name "www"
+   :group circle/circle-group})

 (def known-actions {:build {:prefix [start-nodes checkout]
                             :suffix [stop-nodes]}
@@ -77,7 +78,7 @@
                         {:notify-email (-> config name :notify-email (parse-notify))
                          :build-num num
                          :actions []}
-                        circle-db-data))
+                        (circle-db-data)))
         actions (doall (map (partial parse-action b) (-> config name :commands)))
         before (map #(apply % []) (-> known-actions name :prefix))
         after (map #(apply % []) (-> known-actions name :suffix))]