Typeformat refactor (#14)

Change definitions to be alist instead of positional list for extra flexibility
Refactor internals to operate through records instead of alists
Implement type information for syntax
Minor visual touch ups

Author: arvyy

README.adoc

@@ -34,7 +34,7 @@ Scheme is a functional language and thus it'd be useful to specify taken / retur
 
 Procedures can have more than one entry, even from same library. This occurs, if the procedures is has optional parameters and therefore can be called in multiple ways; or if the result type can be determined more precisely under more specific input parameters.
 
-Structural macros that don't resemble functions are rendered in *green*. If macro is complex, some parts of it are grouped, and the syntax of those groups shown below the syntax of whole macro. Macro literals are also rendered in green. To make parenthesis more obvious, auxiliary parenthesis coloring is used, however this coloring doesn't signify any information.
+Macros are rendered in *green*. If macro is complex, some parts of it are grouped, and the syntax of those groups shown below the syntax of whole macro. Macro literals are also rendered in green. To make parenthesis more obvious, auxiliary parenthesis coloring is used, however this coloring doesn't signify any information.
 
 === Tags
 
@@ -44,7 +44,6 @@ Result items might have one or more of following tags
 * predicate - this procedure that takes any object and returns a boolean. Such procedure may be used as a type;
 * parameterized - the behavior of the procedure depends on a dynamic parameter (ie, uses procedure created with "make-parameter");
 * parameter - this procedure was created with "make-parameter" and may be used in parameterize form;
-* syntax - this is actually a macro, although presented as a procedure (the justification is that combining ad-hoc type annotation with syntax specification might be confusing. Simple macros were subjectively chosen to be shown as if they were procedures if they superficially appear and are called as such. This might be changed in the future);
 * deprecated - not recommended to be used, exists only for backwards compatibility with older SRFIs.
 
 === Filtering logic
@@ -358,7 +357,7 @@ as defined in srfi 180. Otherwise, results are returned as json.
 
 `/rest/params` returns array of types, which were used as a parameter type, found in index as strings;
 
-`/rest/procedures` returns found procedures with faceting meta data. The endpoint accepts following query parameters:
+`/rest/procedures` returns found items with faceting meta data. The endpoint accepts following query parameters:
 
 
 * `query` text search parameter.

pom.xml

@@ -51,6 +51,10 @@
                     <groupId>org.apache.logging.log4j</groupId>
                     <artifactId>log4j-slf4j-impl</artifactId>
                 </exclusion>
+                <exclusion>
+                    <groupId>org.apache.logging.log4j</groupId>
+                    <artifactId>log4j-core</artifactId>
+                </exclusion>
             </exclusions>
         </dependency>
 
@@ -64,9 +68,20 @@
                     <groupId>org.apache.logging.log4j</groupId>
                     <artifactId>log4j-slf4j-impl</artifactId>
                 </exclusion>
+                <exclusion>
+                    <groupId>org.apache.logging.log4j</groupId>
+                    <artifactId>log4j-core</artifactId>
+                </exclusion>
             </exclusions>
         </dependency>
 
+        <!-- https://mvnrepository.com/artifact/org.slf4j/log4j-over-slf4j -->
+        <dependency>
+            <groupId>org.slf4j</groupId>
+            <artifactId>log4j-over-slf4j</artifactId>
+            <version>1.7.36</version>
+        </dependency>
+
         <dependency>
             <groupId>com.github.arvyy.kawa-web-collection</groupId>
             <artifactId>spark</artifactId>

solrhome/scmindex/conf/schema.xml

@@ -28,6 +28,7 @@
     <field name="param_names" type="text_general" indexed="true" stored="true" multiValued="true"/>
     <field name="tags" type="strings" indexed="true" stored="true" />
     <field name="param_signatures" type="string" indexed="false" stored="true" />
+    <field name="syntax_param_signatures" type="string" indexed="false" stored="true" />
     <field name="param_types" type="strings" indexed="true" stored="true" />
     <field name="param_subtypes" type="strings" indexed="true" stored="true" />
     <field name="param_subtypes_loose" type="strings" indexed="true" stored="true" />

src/main/resources/logback.xml

@@ -1,7 +1,15 @@
 <configuration>
+
   <property name="LOG_ROOT" value="logs" />
   <property name="LOG_FILE_NAME" value="scmindex" />
 
+
+  <appender name="STDOUT" class="ch.qos.logback.core.ConsoleAppender">
+    <encoder>
+      <pattern>%d{HH:mm:ss.SSS} [%thread] %-5level %logger{36} - %msg%n</pattern>
+    </encoder>
+  </appender>
+
   <appender name="FILE" class="ch.qos.logback.core.rolling.RollingFileAppender">
     <file>${LOG_ROOT}/${LOG_FILE_NAME}.log</file>
     <rollingPolicy class="ch.qos.logback.core.rolling.SizeAndTimeBasedRollingPolicy">
@@ -16,6 +24,8 @@
   </appender>
 
   <root level="INFO">
+    <appender-ref ref="STDOUT" />"
     <appender-ref ref="FILE" />
   </root>
+
 </configuration>

src/main/scheme/scmindex/domain.scm

@@ -0,0 +1,140 @@
+(define-library
+    (scmindex domain)
+    (import (scheme base)
+            (scheme read)
+            (scheme write))
+    (export
+
+          make-search-result
+          search-result?
+          search-result-items
+          search-result-total
+          search-result-libs
+          search-result-params
+          search-result-tags
+          search-result-returns
+
+          make-search-result-facet
+          search-result-facet?
+          search-result-facet-value
+          search-result-facet-count
+
+          make-func
+          func?
+          func-lib
+          func-name
+          func-param-names
+          func-signature
+          func-param-signatures
+          func-syntax-param-signatures
+          func-tags
+          func-param-types
+          func-return-types
+          func-supertypes
+
+          func->json
+          json->func
+          search-result->json
+    )
+    (begin
+
+    (define-record-type <scmindex-function>
+                        (make-func
+                          lib
+                          name
+                          param-names
+                          signature
+                          param-signatures
+                          syntax-param-signatures
+                          tags
+                          param-types
+                          return-types
+                          supertypes)
+
+                        func?
+
+                        (lib func-lib)
+                        (name func-name)
+                        (param-names func-param-names)
+                        (signature func-signature)
+                        (param-signatures func-param-signatures)
+                        (syntax-param-signatures func-syntax-param-signatures)
+                        (tags func-tags)
+                        (param-types func-param-types)
+                        (return-types func-return-types)
+                        (supertypes func-supertypes))
+
+    ;;TODO move to util?
+    (define (->string obj)
+      (define port (open-output-string))
+      (write obj port)
+      (get-output-string port))
+
+    (define (read* str)
+        (define port (open-input-string str))
+        (read port))
+
+    (define (func->json func)
+      `((lib . ,(->string (func-lib func)))
+        (name . ,(symbol->string (func-name func)))
+        (param_names . ,(list->vector (map ->string (func-param-names func))))
+        (signature . ,(->string (func-signature func)))
+        (param_signatures . ,(->string (func-param-signatures func)))
+        (syntax_param_signatures . ,(->string (func-syntax-param-signatures func)))
+        (tags . ,(list->vector (map ->string (func-tags func))))
+        (param_types . ,(list->vector (map ->string (func-param-types func))))
+        (return_types . ,(list->vector (map ->string (func-return-types func))))
+        (super_types . ,(list->vector (map ->string (func-supertypes func))))))
+
+    (define (json->func json)
+        (define (get field type default)
+            (cond
+                ((assoc field json) =>
+                 (lambda (value)
+                    (case type
+                        ((sexpr) (read* (cdr value)))
+                        ((symbol) (string->symbol (cdr value)))
+                        ((symbol-lst) (map string->symbol (vector->list (cdr value))))
+                        (else (cdr value)))))
+                (else default)))
+        (make-func
+            (get 'lib 'sexpr #f)
+            (get 'name 'symbol #f)
+            (get 'param_names 'symbol-lst '())
+            (get 'signature 'sexpr #f)
+            (get 'param_signatures 'sexpr '())
+            (get 'syntax_param_signatures 'sexpr '())
+            (get 'tags 'symbol-lst '())
+            (get 'param_types 'symbol-lst '())
+            (get 'return_types 'symbol-lst '())
+            (get 'supertypes 'symbol-lst '())))
+
+    (define-record-type <search-result>
+        (make-search-result items total libs params tags returns)
+        search-result?
+        (items search-result-items)
+        (total search-result-total)
+        (libs search-result-libs)
+        (params search-result-params)
+        (tags search-result-tags)
+        (returns search-result-returns))
+
+    (define-record-type <search-result-facet>
+        (make-search-result-facet value count)
+        search-result-facet?
+        (value search-result-facet-value)
+        (count search-result-facet-count))
+
+    (define (search-result->json sr)
+        `((items . ,(list->vector (map func->json (search-result-items sr))))
+          (total . ,(search-result-total sr))
+          (libs . ,(list->vector (map search-result-facet->json (search-result-libs sr))))
+          (params . ,(list->vector (map search-result-facet->json (search-result-params sr))))
+          (returns . ,(list->vector (map search-result-facet->json (search-result-returns sr))))
+          (tags . ,(list->vector (map search-result-facet->json (search-result-tags sr))))))
+
+    (define (search-result-facet->json f)
+        `((value . ,(->string (search-result-facet-value f)))
+          (count . ,(search-result-facet-count f))))
+
+))