expression-writer.rkt

#lang rosette

(require json)
(require "interp-enumerate.rkt")

; array of mappings functions to expression operators, and their types
(define mappings (make-hash))
(hash-set! mappings 'or '("or" "BinaryExpression"))
(hash-set! mappings 'and '("and" "BinaryExpression"))
(hash-set! mappings 'not '("not" "UnaryExpression"))
(hash-set! mappings '= '("eq" "BinaryExpression"))
(hash-set! mappings '<= '("leq" "BinaryExpression"))
(hash-set! mappings '!= '("neq" "BinaryExpression"))
(hash-set! mappings '>= '("geq" "BinaryExpression"))
(hash-set! mappings '< '("lt" "BinaryExpression"))
(hash-set! mappings '> '("gt" "BinaryExpression"))
(hash-set! mappings 'replace '("replace" "TernaryExpression"))
(hash-set! mappings 'create-date '("create-date" "TernaryExpression"))
(hash-set! mappings 'create-time '("create-time" "TernaryExpression"))
(hash-set! mappings 'like '("like" "BinaryExpression"))
(hash-set! mappings 'now '("now" "EmptyExpression"))
(hash-set! mappings 'trim '("trim" "UnaryExpression"))
(hash-set! mappings 'logarithm '("logarithm" "UnaryExpression"))
(hash-set! mappings 'natural-logarithm '("natural-logarithm" "UnaryExpression"))
(hash-set! mappings 'exponent '("exponent" "BinaryExpression"))
(hash-set! mappings 'concat '("concat" "BinaryExpression"))
(hash-set! mappings '+ '("plus" "BinaryExpression"))
(hash-set! mappings '- '("minus" "BinaryExpression"))
(hash-set! mappings '/ '("divide" "BinaryExpression"))
(hash-set! mappings '* '("multiply" "BinaryExpression"))
(hash-set! mappings 'quotient '("quotient" "BinaryExpression"))
(hash-set! mappings 'remainder '("modulo" "BinaryExpression"))
(hash-set! mappings 'round '("round" "UnaryExpression"))
(hash-set! mappings 'abs '("absolute" "UnaryExpression"))
(hash-set! mappings 'sqrt '("sqrt" "UnaryExpression"))
(hash-set! mappings 'upper '("upper" "UnaryExpression"))
(hash-set! mappings 'lower '("lower" "UnaryExpression"))
(hash-set! mappings 'avg '("average" "UnaryExpression"))
(hash-set! mappings 'min '("minimum" "UnaryExpression"))
(hash-set! mappings 'max '("maximum" "UnaryExpression"))
(hash-set! mappings 'sum '("sum" "UnaryExpression"))
(hash-set! mappings 'count '("count" "UnaryExpression"))
(hash-set! mappings 'between '("between" "TernaryExpression"))
(hash-set! mappings 'average-group '("average-group" "BinaryExpression"))
(hash-set! mappings 'minimum-group '("minimum-group" "BinaryExpression"))
(hash-set! mappings 'maximum-group '("maximum-group" "BinaryExpression"))
(hash-set! mappings 'sum-group '("sum-group" "BinaryExpression"))
(hash-set! mappings 'count-group '("count-group" "BinaryExpression"))
(hash-set! mappings 'ceiling '("ceiling" "UnaryExpression"))
(hash-set! mappings 'floor '("floor" "UnaryExpression"))
(hash-set! mappings 'truncate '("truncate" "UnaryExpression"))
(hash-set! mappings 'sign '("sign" "UnaryExpression"))
(hash-set! mappings 'if '("ifelse" "TernaryExpression"))
(hash-set! mappings 'substring '("substring" "TernaryExpression"))
(hash-set! mappings 'index-of '("index-of" "BinaryExpression"))
(hash-set! mappings 'length '("string-length" "UnaryExpression"))
(hash-set! mappings 'in-list '("in-list" "BinaryExpression"))
(hash-set! mappings '== '("eq" "BinaryExpression"))
(hash-set! mappings 'in '("column" "Column"))
(hash-set! mappings 'is-null '("is-null" "UnaryExpression"))
(hash-set! mappings 'is-not-null '("is-not-null" "UnaryExpression"))
(hash-set! mappings 'date-subtract '("date-subtract" "BinaryExpression"))
(hash-set! mappings 'date-le '("date-le" "BinaryExpression"))
(hash-set! mappings 'date-lt '("date-lt" "BinaryExpression"))
(hash-set! mappings 'date-ge '("date-ge" "BinaryExpression"))
(hash-set! mappings 'date-gt '("date-gt" "BinaryExpression"))
(hash-set! mappings 'date-equal '("date-equal" "BinaryExpression"))
(hash-set! mappings 'add-seconds '("add-seconds" "BinaryExpression"))
(hash-set! mappings 'add-minutes '("add-minutes" "BinaryExpression"))
(hash-set! mappings 'add-hours '("add-hours" "BinaryExpression"))
(hash-set! mappings 'add-days '("add-days" "BinaryExpression"))
(hash-set! mappings 'add-months '("add-months" "BinaryExpression"))
(hash-set! mappings 'add-years '("add-years" "BinaryExpression"))
(hash-set! mappings 'subtract-seconds '("subtract-seconds" "BinaryExpression"))
(hash-set! mappings 'subtract-minutes '("subtract-minutes" "BinaryExpression"))
(hash-set! mappings 'subtract-hours '("subtract-hours" "BinaryExpression"))
(hash-set! mappings 'subtract-days '("subtract-days" "BinaryExpression"))
(hash-set! mappings 'subtract-months '("subtract-months" "BinaryExpression"))
(hash-set! mappings 'subtract-years '("subtract-years" "BinaryExpression"))
(hash-set! mappings 'extract-seconds '("extract-seconds" "UnaryExpression"))
(hash-set! mappings 'extract-minutes '("extract-minutes" "UnaryExpression"))
(hash-set! mappings 'extract-hours '("extract-hours" "UnaryExpression"))
(hash-set! mappings 'extract-days '("extract-days" "UnaryExpression"))
(hash-set! mappings 'extract-months '("extract-months" "UnaryExpression"))
(hash-set! mappings 'extract-years '("extract-years" "UnaryExpression"))
(hash-set! mappings 'extract-day-of-week '("extract-day-of-week" "UnaryExpression"))
(hash-set! mappings 'extract-day-of-year '("extract-day-of-year" "UnaryExpression"))
(hash-set! mappings 'date-to-epoch '("date-to-epoch" "UnaryExpression"))
(hash-set! mappings 'date-from-epoch '("date-from-epoch" "UnaryExpression"))
(hash-set! mappings 'group-concat '("group-concat" "UnaryExpression"))
(hash-set! mappings 'set-to-first-day-of-month '("set-to-first-day-of-month" "UnaryExpression"))
(hash-set! mappings 'set-to-last-day-of-month '("set-to-last-day-of-month" "UnaryExpression"))
(hash-set! mappings 'set-to-first-month '("set-to-first-month" "UnaryExpression"))
(hash-set! mappings 'set-to-last-month '("set-to-last-month" "UnaryExpression"))
(hash-set! mappings 'set-to-next-day '("set-to-next-day" "UnaryExpression"))
(hash-set! mappings 'set-to-next-month '("set-to-next-month" "UnaryExpression"))
(hash-set! mappings 'set-to-previous-day '("set-to-previous-day" "UnaryExpression"))
(hash-set! mappings 'set-to-previous-month '("set-to-previous-month" "UnaryExpression"))
(hash-set! mappings 'set-seconds-to '("set-seconds-to" "BinaryExpression"))
(hash-set! mappings 'set-minutes-to '("set-minutes-to" "BinaryExpression"))
(hash-set! mappings 'set-hours-to '("set-hours-to" "BinaryExpression"))
(hash-set! mappings 'set-days-to '("set-days-to" "BinaryExpression"))
(hash-set! mappings 'set-months-to '("set-months-to" "BinaryExpression"))
(hash-set! mappings 'set-years-to '("set-years-to" "BinaryExpression"))
(hash-set! mappings 'is-in-current-month '("is-in-current-month" "UnaryExpression"))
(hash-set! mappings 'is-in-last-x-months '("is-in-last-x-months" "BinaryExpression"))
(hash-set! mappings 'days360 '("days360" "BinaryExpression"))

(hash-set! mappings 'not '("not" "UnaryExpression"))



; define a set of mappings from functions to their pretty equivalents
(define pretty (make-hash))
(hash-set! pretty 'or "lhs or rhs")
(hash-set! pretty 'and "lhs and rhs")
(hash-set! pretty 'not "is not expression")
(hash-set! pretty '= "lhs = rhs")
(hash-set! pretty '<= "lhs <= rhs")
(hash-set! pretty '>= "lhs >= rhs")
(hash-set! pretty '< "(lhs < rhs)")
(hash-set! pretty '> "lhs > rhs")
(hash-set! pretty 'concat "lhs concatenated with rhs")
(hash-set! pretty '+ "lhs + rhs")
(hash-set! pretty '- "(lhs - rhs)")
(hash-set! pretty '/ "lhs / rhs")
(hash-set! pretty '* "lhs * rhs")
(hash-set! pretty 'like "lhs is like rhs")
(hash-set! pretty 'now "current time")
(hash-set! pretty 'logarithm "logarithm of expression")
(hash-set! pretty 'exponent "exponent of expression")
(hash-set! pretty 'quotient "quotient when lhs / rhs")
(hash-set! pretty 'remainder "remainder when lhs / rhs")
(hash-set! pretty 'abs "absolute value of expression")
(hash-set! pretty 'between "one is between two and three")
(hash-set! pretty 'round "round expression")
(hash-set! pretty 'ceiling "ceiling of expression")
(hash-set! pretty 'floor "floor of expression")
(hash-set! pretty 'truncate "truncated expression")
(hash-set! pretty 'sign "sign of expression")
(hash-set! pretty 'if "if one then two otherwise three")
(hash-set! pretty 'substring "a part of one from location two to location three")
(hash-set! pretty 'index-of "location of rhs in lhs")
(hash-set! pretty 'length "length of expression")
(hash-set! pretty 'in-list "lhs in rhs")
(hash-set! pretty '== "lhs = rhs")
(hash-set! pretty '!= "lhs != rhs")
(hash-set! pretty 'in "expression")
(hash-set! pretty 'is-null "expression is null")
(hash-set! pretty 'is-not-null "expression is not null")
(hash-set! pretty 'date-le "lhs <= rhs")
(hash-set! pretty 'date-lt "lhs < rhs")
(hash-set! pretty 'date-ge "lhs >= rhs")
(hash-set! pretty 'date-gt "lhs > rhs")
(hash-set! pretty 'date-equal "lhs = rhs")
(hash-set! pretty 'add-seconds "lhs + rhs seconds")
(hash-set! pretty 'add-minutes "lhs + rhs minutes")
(hash-set! pretty 'add-hours "lhs + rhs hours")
(hash-set! pretty 'add-days "lhs + rhs days")
(hash-set! pretty 'add-months "lhs + rhs months")
(hash-set! pretty 'add-years "lhs + rhs years")
(hash-set! pretty 'subtract-seconds "lhs - rhs seconds")
(hash-set! pretty 'subtract-minutes "lhs - rhs minutes")
(hash-set! pretty 'subtract-hours "lhs - rhs hours")
(hash-set! pretty 'subtract-days "lhs - rhs days")
(hash-set! pretty 'subtract-months "lhs - rhs months")
(hash-set! pretty 'subtract-years "lhs - rhs years")
(hash-set! pretty 'extract-seconds "extract seconds from expression")
(hash-set! pretty 'extract-minutes "extract minutes from expression")
(hash-set! pretty 'extract-hours "extract hours from expression")
(hash-set! pretty 'extract-days "extract days from expresison")
(hash-set! pretty 'extract-months "extract months from expression")
(hash-set! pretty 'extract-years "extract years from expression")
(hash-set! pretty 'extract-day-of-week "extract day of week from expression")
(hash-set! pretty 'extract-day-of-year "extract day of year from expression")
(hash-set! pretty 'date-to-epoch "extract unix time from expression")
(hash-set! pretty 'date-from-epoch "create date from unix time")
(hash-set! pretty 'create-date "make a new date")
(hash-set! pretty 'create-time "make a new time")
(hash-set! pretty 'sqrt "square root of expression")
(hash-set! pretty 'upper "expression to upper case")
(hash-set! pretty 'lower "expression to lower case")
(hash-set! pretty 'avg "average of expression")
(hash-set! pretty 'min "minumum of expression")
(hash-set! pretty 'max "maximum of expression")
(hash-set! pretty 'sum "sum of expression")
(hash-set! pretty 'count "count expression")
(hash-set! pretty 'replace "replace two with three in one")
(hash-set! pretty 'like "lhs is like rhs")
(hash-set! pretty 'now "currentTime")
(hash-set! pretty 'logarithm "logarithm of expresion")
(hash-set! pretty 'natural-logarithm "natural logarithm of expresion")
(hash-set! pretty 'average-group "average lhs grouped by rhs")
(hash-set! pretty 'minimum-group "minimum lhs grouped by rhs")
(hash-set! pretty 'maximum-group "maximum lhs grouped by rhs")
(hash-set! pretty 'sum-group "sum lhs grouped by rhs")
(hash-set! pretty 'count-group "count lhs grouped by rhs")
(hash-set! pretty 'not "not expression")
(hash-set! pretty 'group-concat "concatenate all strings in expression")
(hash-set! pretty 'set-to-first-day-of-month "set to first day of month of expression")
(hash-set! pretty 'set-to-last-day-of-month "set to last day of month of expression")
(hash-set! pretty 'set-to-first-month "set to first month of expression")
(hash-set! pretty 'set-to-last-month "set to last month of expression")
(hash-set! pretty 'set-to-next-day "set to next day of expression")
(hash-set! pretty 'set-to-next-month "set to next month of expression")
(hash-set! pretty 'set-to-previous-day "set to previous day of expression")
(hash-set! pretty 'set-to-previous-month "set to previous month of expression")
(hash-set! pretty 'set-seconds-to "set seconds in lhs to rhs")
(hash-set! pretty 'set-minutes-to "set minutes in lhs to rhs")
(hash-set! pretty 'set-hours-to "set hours in lhs to rhs")
(hash-set! pretty 'set-days-to "set days in lhs to rhs")
(hash-set! pretty 'set-months-to "set months in lhs to rhs")
(hash-set! pretty 'set-years-to "set years in lhs to rhs")
(hash-set! pretty 'trim "trim white spaces from expression")
(hash-set! pretty 'is-in-current-month "expression is in current month")
(hash-set! pretty 'is-in-last-x-months "left is in last right months")
(hash-set! pretty 'days360 "days360 of left, right")


(define (check-exp type)
  (if (hash-has-key? mappings type)
      (hash-ref mappings type)
      (raise "No expression found")))

(define (create-value-exp n)
  (list 'objectType "ValueExpression" 'operator "value" 'value n))
               
; get the output of render and rewrite it as json - assume we will only write the first solution
(define (jsonify tree column-metadata)
  (letrec ((print-tree
            (lambda (node)
              (if (list? node)
                  (letrec
                      ((exp (check-exp (list-ref node 0)))
                       (base (list 'objectType (list-ref exp 1) 'operator (list-ref exp 0))))
                    (cond [(equal? "Column" (list-ref exp 1))
                           ; if expression is equal to column, then pull some metadata of the column
                           ; directly off the column data that was posted to the server.
                           ; Need code to understand what that data structure should be
                           (apply hasheq (append base (list-ref column-metadata (- (list-ref node 1) 1))))]
                          [(equal? "EmptyExpression" (list-ref exp 1))
                           (apply hasheq (append base (list 'expression)))]
                          [(equal? "UnaryExpression" (list-ref exp 1))
                           (apply hasheq (append base (list 'expression (print-tree (cadr node)))))]
                          [(equal? "BinaryExpression" (list-ref exp 1))
                           (apply hasheq (append base (list 'lhs (print-tree (list-ref node 1)) 'rhs (print-tree (list-ref node 2)))))]
                          [(equal? "TernaryExpression" (list-ref exp 1))
                           (if (= (length node) 4)
                               (apply hasheq (append base (list 'one (print-tree (list-ref node 1)) 'two (print-tree (list-ref node 2)) 'three (print-tree (list-ref node 3)))))
                               (apply hasheq (append base (list 'one (print-tree (list-ref node 1)) 'two (print-tree (list-ref node 2))))))]))
                  (apply hasheq (create-value-exp node))))))
    (print-tree tree)))

(define (handle-args l replaceArg text f)
  (for/fold ([t text])
            ([i (in-range 1 (length l))]
             [j replaceArg])
    (string-replace t j (f (list-ref l i)) #:all? #f)))

(define (handle l replaceArg text f)
  (let ((txt (handle-args l replaceArg text f)))
    (for/fold ([t txt])
              ([i replaceArg])
      (string-replace t i "**insert missing formula part here**" #:all? #f))))


; create an HTML text around this solution.  Add spans for functions so that they can get turned into 'black lists'
(define (to-html tree col-metadata)
  (letrec ((print-tree
            (lambda (node)
              (if (list? node)
                  (let ((text (hash-ref pretty (list-ref node 0)))
                        (exp (check-exp (list-ref node 0))))
                    (cond [(equal? "Column" (list-ref exp 1))
                           ; if expression is equal to column, then pull some metadata of the column
                           ; directly off the column data that was posted to the server.
                           (let ((colAttrs (apply hasheq (list-ref col-metadata (- (list-ref node 1) 1)))))
                             (string-replace text "expression" (hash-ref colAttrs 'columnName) #:all? #f))]
                          [(equal? "UnaryExpression" (list-ref exp 1))
                           (string-append "(" (handle node '("expression") text print-tree) ")")]
                          [(equal? "BinaryExpression" (list-ref exp 1))
                             (string-append "(" (handle node '("lhs" "rhs") text print-tree) ")")]
                          [(equal? "TernaryExpression" (list-ref exp 1))
                             (string-append "(" (handle node '("one" "two" "three") text print-tree) ")")]))
                  (string-append (~a node))))))
    (print-tree tree)))


(provide to-html jsonify)