(ns ^{:doc 
      :author "Simon Brooke"}
  mw-parser.declarative
  (:require [instaparse.core :as insta]
            [clojure.string :refer [split trim triml]]
            [mw-parser.errors :as pe]
            [mw-parser.generate :as pg]
            [mw-parser.simplify :as ps]
            [mw-parser.utils :refer [rule?]]))

(def grammar
  ;; in order to simplify translation into other natural languages, all
  ;; TOKENS within the parser should be unambiguous
  "RULE := IF SPACE CONDITIONS SPACE THEN SPACE ACTIONS;
   CONDITIONS := DISJUNCT-CONDITION | CONJUNCT-CONDITION | CONDITION ;
   DISJUNCT-CONDITION := CONDITION SPACE OR SPACE CONDITIONS;
   CONJUNCT-CONDITION := CONDITION SPACE AND SPACE CONDITIONS;
   CONDITION := WITHIN-CONDITION | NEIGHBOURS-CONDITION | PROPERTY-CONDITION;
   WITHIN-CONDITION := QUANTIFIER SPACE NEIGHBOURS SPACE WITHIN SPACE NUMBER SPACE IS SPACE PROPERTY-CONDITION-OR-EXPRESSION;
   NEIGHBOURS-CONDITION := QUANTIFIER SPACE NEIGHBOURS SPACE IS SPACE PROPERTY-CONDITION | QUALIFIER SPACE NEIGHBOURS-CONDITION;
   PROPERTY-CONDITION-OR-EXPRESSION := PROPERTY-CONDITION | EXPRESSION;
   PROPERTY-CONDITION := PROPERTY SPACE QUALIFIER SPACE EXPRESSION | VALUE;
   EXPRESSION := SIMPLE-EXPRESSION | RANGE-EXPRESSION | NUMERIC-EXPRESSION | DISJUNCT-EXPRESSION | VALUE;
   SIMPLE-EXPRESSION := QUALIFIER SPACE EXPRESSION | VALUE;
   DISJUNCT-EXPRESSION := IN SPACE DISJUNCT-VALUE;
   RANGE-EXPRESSION := BETWEEN SPACE NUMERIC-EXPRESSION SPACE AND SPACE NUMERIC-EXPRESSION;
   NUMERIC-EXPRESSION := VALUE | VALUE SPACE OPERATOR SPACE NUMERIC-EXPRESSION;
   NEGATED-QUALIFIER := QUALIFIER SPACE NOT | NOT SPACE QUALIFIER;
   COMPARATIVE-QUALIFIER := IS SPACE COMPARATIVE SPACE THAN | COMPARATIVE SPACE THAN;
   QUALIFIER := COMPARATIVE-QUALIFIER | NEGATED-QUALIFIER | EQUIVALENCE | IS SPACE QUALIFIER;
   QUANTIFIER := NUMBER | SOME | NONE | ALL | COMPARATIVE SPACE THAN SPACE NUMBER;
   EQUIVALENCE := IS SPACE EQUAL | EQUAL | IS ;
   COMPARATIVE := MORE | LESS;
   DISJUNCT-VALUE := VALUE | VALUE SPACE OR SPACE DISJUNCT-VALUE;
   IF := 'if';
   THEN := 'then';
   THAN := 'than';
   OR := 'or';
   NOT := 'not';
   AND := 'and';
   SOME := 'some';
   NONE := 'no';
   ALL := 'all'
   BETWEEN := 'between';
   WITHIN := 'within';
   IN := 'in';
   MORE := 'more' | 'greater';
   LESS := 'less' | 'fewer';
   OPERATOR := '+' | '-' | '*' | '/';
   NEIGHBOURS := 'neighbour' | 'neighbor' | 'neighbours' | 'neighbors';
   PROPERTY := SYMBOL;
   VALUE := SYMBOL | NUMBER;
   EQUAL := 'equal to';
   IS := 'is' | 'are' | 'have' | 'has';
   NUMBER := #'[0-9]+' | #'[0-9]+.[0-9]+';
   SYMBOL := #'[a-z]+';
   ACTIONS := ACTION | ACTION SPACE AND SPACE ACTIONS
   ACTION := SIMPLE-ACTION | PROBABLE-ACTION;
   PROBABLE-ACTION := VALUE SPACE CHANCE-IN SPACE VALUE SPACE SIMPLE-ACTION;
   SIMPLE-ACTION := SYMBOL SPACE BECOMES SPACE EXPRESSION;
   CHANCE-IN := 'chance in';
   BECOMES := 'should be' | 'becomes';
   SPACE := #' *'";)

(def parse-rule
  (insta/parser grammar))

(defn compile-rule
  ([rule-text return-tuple?]
   (assert (string? rule-text))
   (let [rule (trim rule-text)
         tree (ps/simplify (parse-rule rule))
         afn (if (rule? tree) (eval (pg/generate tree))
               ;; else
               (pe/throw-parse-exception tree))]
     (if return-tuple?
       (list afn rule)
       ;; else
       afn)))
  ([rule-text]
   (compile-rule rule-text false)))

(ns ^{:doc 
      :author "Simon Brooke"}
  mw-parser.generate
  (:require [mw-engine.utils :refer []]
        [mw-parser.utils :refer [assert-type TODO]]
        [mw-parser.errors :as pe]))

(declare generate generate-action)

(defn generate-rule
  [tree]
  (assert-type tree :RULE)
  (list 'fn ['cell 'world] (list 'if (generate (nth tree 2)) (generate (nth tree 3)))))

(defn generate-conditions
  [tree]
  (assert-type tree :CONDITIONS)
  (generate (second tree)))

(defn generate-condition
  [tree]
  (assert-type tree :CONDITION)
  (generate (second tree)))

(defn generate-conjunct-condition
  [tree]
  "From this `tree`, assumed to be a syntactically conjunct correct condition clause,
  generate and return the appropriate clojure fragment."
  (assert-type tree :CONJUNCT-CONDITION)
  (cons 'and (map generate (rest tree))))

(defn generate-disjunct-condition
  [tree]
  (assert-type tree :DISJUNCT-CONDITION)
  (cons 'or (map generate (rest tree))))

(defn generate-ranged-property-condition
  [tree property expression]
   (assert-type tree :PROPERTY-CONDITION)
   (assert-type (nth tree 3) :RANGE-EXPRESSION)
   (let [l1 (generate (nth expression 2))
         l2 (generate (nth expression 4))
         pv (list property 'cell)]
     (list 'let ['lower (list 'min l1 l2)
                 'upper (list 'max l1 l2)]
           (list 'and (list '>= pv 'lower)(list '<= pv 'upper)))))

(defn generate-disjunct-property-condition
  ([tree]
   (let [property (generate (second tree))
         qualifier (generate (nth tree 2))
         expression (generate (nth tree 3))]
     (generate-disjunct-property-condition tree property qualifier expression)))
  ([tree property qualifier expression]
   (let [e (list 'some (list 'fn ['i] '(= i value)) (list 'quote expression))]
     (list 'let ['value (list property 'cell)]
           (if (= qualifier '=) e
             (list 'not e))))))

(defn generate-property-condition
  ([tree]
   (assert-type tree :PROPERTY-CONDITION)
   (if
     (and (= (count tree) 2) (= (first (second tree)) :SYMBOL))
     ;; it's a shorthand for 'state equal to symbol'. This should probably have
     ;; been handled in simplify...
     (generate-property-condition
       (list
         :PROPERTY-CONDITION
         '(:SYMBOL "state")
         '(:QUALIFIER (:EQUIVALENCE (:EQUAL "equal to")))
         (second tree)))
     ;; otherwise...
     (generate-property-condition tree (first (nth tree 3)))))
  ([tree expression-type]
   (assert-type tree :PROPERTY-CONDITION)
   (let [property (generate (second tree))
         qualifier (generate (nth tree 2))
         e (generate (nth tree 3))
         expression (cond
                      (and (not (= qualifier '=)) (keyword? e)) (list 'or (list e 'cell) e)
                      (and (not (= qualifier 'not=)) (keyword? e)) (list 'or (list e 'cell) e)
                      :else e)]
     (case expression-type
       :DISJUNCT-EXPRESSION (generate-disjunct-property-condition tree property qualifier expression)
       :RANGE-EXPRESSION (generate-ranged-property-condition tree property expression)
       (list qualifier (list property 'cell) expression)))))

(defn generate-qualifier
  [tree]
  (if
    (= (count tree) 2)
    (generate (second tree))
    ;; else
    (generate (nth tree 2))))

(defn generate-simple-action
  ([tree]
   (assert-type tree :SIMPLE-ACTION)
   (generate-simple-action tree []))
  ([tree others]
   (assert-type tree :SIMPLE-ACTION)
   (let [property (generate (second tree))
         expression (generate (nth tree 3))]
     (if (or (= property :x) (= property :y))
       (throw (Exception. pe/reserved-properties-error))
       (list 'merge
             (if (empty? others) 'cell
               ;; else
               (generate others))
             {property expression})))))

(defn generate-probable-action
  ([tree]
   (assert-type tree :PROBABLE-ACTION)
   (generate-probable-action tree []))
  ([tree others]
   (assert-type tree :PROBABLE-ACTION)
  (let
    [chances (generate (nth tree 1))
     total (generate (nth tree 2))
     action (generate-action (nth tree 3) others)]
    ;; TODO: could almost certainly be done better with macro syntax
    (list 'if
          (list '< (list 'rand total) chances)
          action))))

(defn generate-action
  [tree others]
  (case (first tree)
    :ACTIONS (generate-action (first tree) others)
    :SIMPLE-ACTION (generate-simple-action tree others)
    :PROBABLE-ACTION (generate-probable-action tree others)
    (throw (Exception. (str "Not a known action type: " (first tree))))))

(defn generate-multiple-actions
  [tree]
  (assert-type tree :ACTIONS)
  (generate-action (first (rest tree)) (second (rest tree))))

(defn generate-disjunct-value
  [tree]
  (assert-type tree :DISJUNCT-VALUE)
  (if (= (count tree) 4)
    (cons (generate (second tree)) (generate (nth tree 3)))
    (list (generate (second tree)))))

(defn generate-numeric-expression
  [tree]
  (assert-type tree :NUMERIC-EXPRESSION)
  (case (count tree)
    4 (let [[p operator expression] (rest tree)
            property (if (number? p) p (list p 'cell))]
        (list (generate operator) (generate property) (generate expression)))
    (case (first (second tree))
      :SYMBOL (list (keyword (second (second tree))) 'cell)
      (generate (second tree)))))

(defn generate-neighbours-condition
  ([tree]
   (assert-type tree :NEIGHBOURS-CONDITION)
   (case (first (second tree))
     :NUMBER (read-string (second (second tree)))
     :QUANTIFIER (generate-neighbours-condition tree (first (second (second tree))))
     :QUALIFIER (cons (generate (second tree)) (rest (generate (nth tree 2))))))
  ([tree quantifier-type]
   (let [quantifier (second tree)
         pc (generate (nth tree 4))]
     (case quantifier-type
       :NUMBER (generate-neighbours-condition '= (read-string (second (second quantifier))) pc 1)
       :SOME (generate-neighbours-condition '> 0 pc 1)
       :MORE (let [value (generate (nth quantifier 3))]
               (generate-neighbours-condition '> value pc 1))
       :LESS (let [value (generate (nth quantifier 3))]
               (generate-neighbours-condition '< value pc 1)))))
  ([comp1 quantity property-condition distance]
   (list comp1
         (list 'count
               (list 'remove 'false?
                     (list 'map (list 'fn ['cell] property-condition)
                           (list 'mw-engine.utils/get-neighbours 'world 'cell distance)))) quantity))
  ([comp1 quantity property-condition]
   (generate-neighbours-condition comp1 quantity property-condition 1)))

(defn generate-within-condition
  ([tree]
  (assert-type tree :WITHIN-CONDITION)
    (case (first (second tree))
      :QUANTIFIER (generate-within-condition tree (first (second (second tree))))
      :QUALIFIER (TODO "qualified within... help!")))
  ([tree quantifier-type]
   (let [quantifier (second tree)
         distance (generate (nth tree 4))
         pc (generate (nth tree 6))]
     (case quantifier-type
       :NUMBER (generate-neighbours-condition '= (read-string (second (second quantifier))) pc distance)
       :SOME (generate-neighbours-condition '> 0 pc distance)
       :MORE (let [value (generate (nth quantifier 3))]
               (generate-neighbours-condition '> value pc distance))
       :LESS (let [value (generate (nth quantifier 3))]
               (generate-neighbours-condition '< value pc distance))))))

(defn generate
  [tree]
  (if
    (coll? tree)
    (case (first tree)
      :ACTIONS (generate-multiple-actions tree)
      :COMPARATIVE (generate (second tree))
      :COMPARATIVE-QUALIFIER (generate (second tree))
      :CONDITION (generate-condition tree)
      :CONDITIONS (generate-conditions tree)
      :CONJUNCT-CONDITION (generate-conjunct-condition tree)
      :DISJUNCT-CONDITION (generate-disjunct-condition tree)
      :DISJUNCT-EXPRESSION (generate (nth tree 2))
      :DISJUNCT-VALUE (generate-disjunct-value tree)
      :EQUIVALENCE '=
      :EXPRESSION (generate (second tree))
      :LESS '<
      :MORE '>
      :NEGATED-QUALIFIER (case (generate (second tree))
                                 = 'not=
                                 > '<
                                 < '>)
      :NEIGHBOURS-CONDITION (generate-neighbours-condition tree)
      :NUMERIC-EXPRESSION (generate-numeric-expression tree)
      :NUMBER (read-string (second tree))
      :OPERATOR (symbol (second tree))
      :PROBABLE-ACTION (generate-probable-action tree)
      :PROPERTY (list (generate (second tree)) 'cell) ;; dubious - may not be right
      :PROPERTY-CONDITION (generate-property-condition tree)
      :QUALIFIER (generate-qualifier tree)
      :RULE (generate-rule tree)
      :SIMPLE-ACTION (generate-simple-action tree)
      :SYMBOL (keyword (second tree))
      :VALUE (generate (second tree))
      :WITHIN-CONDITION (generate-within-condition tree)
      (map generate tree))
    tree))

(ns ^{:doc 
      :author "Simon Brooke"}
  mw-parser.errors)

(def reserved-properties-error
  "The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions")

(def bad-parse-error "I did not understand:\n  '%s'\n  %s\n  %s")

(defn- explain-parse-error-reason
  [reason]
  (str "Expecting one of (" (apply str (map #(str (:expecting %) " ") reason)) ")"))

(defn- parser-error-to-map
  [parser-error]
  (let [m (reduce (fn [map item](merge map {(first item)(second item)})) {} parser-error)
        reason (map
                 #(reduce (fn [map item] (merge {(first item) (second item)} map)) {} %)
                 (:reason m))]
    (merge m {:reason reason})))

(defn throw-parse-exception
  [parser-error]
  (assert (coll? parser-error) "Expected a paser error structure?")
  (let
    [
      ;; the error structure is a list, such that each element is a list of two items, and
      ;; the first element in each sublist is a keyword. Easier to work with it as a map
     error-map (parser-error-to-map parser-error)
     text (:text error-map)
     reason (explain-parse-error-reason (:reason error-map))
      ;; rules have only one line, by definition; we're interested in the column
     column (if (:column error-map)(:column error-map) 0)
      ;; create a cursor to point to that column
     cursor (apply str (reverse (conj (repeat column " ") "^")))
     message (format bad-parse-error text cursor reason)
     ]
  (throw (Exception. message))))

(ns ^{:doc 
      :author "Simon Brooke"}
  mw-parser.core
  (:use mw-engine.utils
        [clojure.string :only [split trim triml]])
  (:gen-class))

(declare parse-conditions)
(declare parse-not-condition)
(declare parse-simple-condition)

(def re-number #"^[0-9.]*$")

(def reserved-properties-error
  "The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions")

(def bad-parse-error "I did not understand '%s'")

(defn- keyword-or-numeric
  [token]
  (cond
    (re-matches re-number token) (read-string token)
    (keyword? token) token
    true (keyword token)))

(defn parse-numeric-value
  [[value & remainder]]
  (if (and value (re-matches re-number value)) [(read-string value) remainder]))

(defn parse-property-int
  [[value & remainder]]
  (if value [(list 'get-int 'cell (keyword value)) remainder]))

(defn parse-property-value
  [[value & remainder]]
  (if value [(list (keyword value) 'cell) remainder]))

(defn parse-token-value
  [[value & remainder]]
  (if value [(keyword value) remainder]))

(defn parse-simple-value
  ([tokens expect-int]
    (or
        (parse-numeric-value tokens)
        (cond expect-int
          (parse-property-int tokens)
          true (parse-token-value tokens))))
  ([tokens]
    (parse-simple-value tokens false)))

(defn gen-token-value
  [token expect-int]
  (first (parse-simple-value (list token) expect-int)))

(defn parse-disjunct-value
  [[OR token & tokens] expect-int]
  (cond (member? OR '("or" "in"))
    (let [value (first (parse-simple-value (list token) expect-int))
          seek-others (= (first tokens) "or")]
      (cond seek-others
        (let [[others remainder] (parse-disjunct-value tokens expect-int)]
          [(cons value others) remainder])
        true
        [(list value) tokens]))))

(defn parse-value
  ([tokens expect-int]
    (or
      (parse-disjunct-value tokens expect-int)
      (parse-simple-value tokens expect-int)))
  ([tokens]
    (parse-value tokens false)))

(defn parse-member-condition
  [[property IS IN & rest]]
  (if (and (member? IS '("is" "are")) (= IN "in"))
    (let [[l remainder] (parse-disjunct-value (cons "in" rest) false)]
      [(list 'member? (list (keyword property) 'cell) (list 'quote l)) remainder])))

(defn- parse-less-condition
  [[property IS LESS THAN & rest]]
  (cond (and (member? IS '("is" "are")) (member? LESS '("less" "fewer")) (= THAN "than"))
    (let [[value remainder] (parse-value rest true)]
        [(list '< (list 'get-int 'cell (keyword property)) value) remainder])))

(defn- parse-more-condition
  [[property IS MORE THAN & rest]]
  (cond (and (member? IS '("is" "are")) (member? MORE '("more" "greater")) (= THAN "than"))
    (let [[value remainder] (parse-value rest true)]
        [(list '> (list 'get-int 'cell (keyword property)) value) remainder])))

(defn- parse-between-condition
  [[p IS BETWEEN v1 AND v2 & rest]]
  (cond (and (member? IS '("is" "are")) (= BETWEEN "between") (= AND "and") (not (nil? v2)))
    (let [property (first (parse-simple-value (list p) true))
          value1 (first (parse-simple-value (list v1) true))
          value2 (first (parse-simple-value (list v2) true))]
      [(list 'or
            (list '< value1 property value2)
            (list '> value1 property value2)) rest])))

(defn- parse-is-condition
  [[property IS value & rest]]
  (cond
    (member? IS '("is" "are"))
    (let [tokens (cons property (cons value rest))]
      (cond
        (re-matches re-number value) [(list '= (list 'get-int 'cell (keyword property)) (read-string value)) rest]
        value [(list '= (list (keyword property) 'cell) (keyword value)) rest]))))

(defn- parse-not-condition
  [[property IS NOT & rest]]
  (cond (and (member? IS '("is" "are")) (= NOT "not"))
    (let [partial (parse-simple-condition (cons property (cons "is" rest)))]
      (cond partial
        (let [[condition remainder] partial]
          [(list 'not condition) remainder])))))

(defn- gen-neighbours-condition
  ([comp1 quantity property value remainder comp2 distance]
    [(list comp1
         (list 'count
               (list 'get-neighbours-with-property-value 'world
                     '(cell :x) '(cell :y) distance
                     (keyword property) (keyword-or-numeric value) comp2))
         quantity)
           remainder])
  ([comp1 quantity property value remainder comp2]
    (gen-neighbours-condition comp1 quantity property value remainder comp2 1)))

(defn parse-comparator-neighbours-condition
  [[MORE THAN n NEIGHBOURS WITHIN distance have-or-are & rest]]
  (let [quantity (first (parse-numeric-value (list n)))
        comparator (cond (= MORE "more") '>
                     (member? MORE '("fewer" "less")) '<)]
    (cond
      (not= WITHIN "within")
      (parse-comparator-neighbours-condition
        (flatten
          ;; two tokens were mis-parsed as 'within distance' that weren't
          ;; actually 'within' and a distance. Splice in 'within 1' and try
          ;; again.
          (list MORE THAN n NEIGHBOURS "within" "1" WITHIN distance have-or-are rest)))
      (and quantity
           comparator
           (= THAN "than")
           (= NEIGHBOURS "neighbours"))
      (cond
        (= have-or-are "are")
        (let [[value & remainder] rest
              dist (gen-token-value distance true)]
          (gen-neighbours-condition comparator quantity :state value remainder = dist))
        (= have-or-are "have")
        (let [[property comp1 comp2 value & remainder] rest
              dist (gen-token-value distance true)]
          (cond (and (= comp1 "equal") (= comp2 "to"))
            (gen-neighbours-condition comparator quantity property
                                      value remainder = dist)
            (and (= comp1 "more") (= comp2 "than"))
            (gen-neighbours-condition comparator quantity property
                                      value remainder > dist)
            (and (= comp1 "less") (= comp2 "than"))
            (gen-neighbours-condition comparator quantity property
                                      value remainder < dist)))))))

(defn parse-some-neighbours-condition
  [[SOME NEIGHBOURS & rest]]
  (cond
    (and (= SOME "some") (= NEIGHBOURS "neighbours"))
    (parse-comparator-neighbours-condition (concat '("more" "than" "0" "neighbours") rest))))

(defn parse-simple-neighbours-condition
  [[n NEIGHBOURS WITHIN distance have-or-are & rest]]
  (let [quantity (first (parse-numeric-value (list n)))]
    (cond
      (and quantity (= NEIGHBOURS "neighbours"))
      (cond
        (not= WITHIN "within")
        (parse-simple-neighbours-condition
          (flatten
            ;; two tokens were mis-parsed as 'within distance' that weren't
            ;; actually 'within' and a distance. Splice in 'within 1' and try
            ;; again.
            (list n NEIGHBOURS "within" "1" WITHIN distance have-or-are rest)))
        (= have-or-are "are")
        (let [[value & remainder] rest
              dist (gen-token-value distance true)]
          (gen-neighbours-condition '= quantity :state value remainder = dist))
        (= have-or-are "have")
        (let [[property comp1 comp2 value & remainder] rest
              dist (gen-token-value distance true)]
          (cond (and (= comp1 "equal") (= comp2 "to"))
            (gen-neighbours-condition '= quantity property value remainder =
                                      dist)
            (and (= comp1 "more") (= comp2 "than"))
            (gen-neighbours-condition '= quantity property value remainder >
                                      dist)
            (and (= comp1 "less") (= comp2 "than"))
            (gen-neighbours-condition '= quantity property value remainder <
                                      dist)))))))

(defn parse-neighbours-condition
  [tokens]
  (or
    (parse-simple-neighbours-condition tokens)
    (parse-comparator-neighbours-condition tokens)
    (parse-some-neighbours-condition tokens)))

(defn parse-simple-condition
  [tokens]
  (or
    (parse-neighbours-condition tokens)
    (parse-member-condition tokens)
    (parse-not-condition tokens)
    (parse-less-condition tokens)
    (parse-more-condition tokens)
    (parse-between-condition tokens)
    (parse-is-condition tokens)))

(defn- parse-disjunction-condition
  [left tokens]
  (let [partial (parse-conditions tokens)]
    (if partial
      (let [[right remainder] partial]
        [(list 'or left right) remainder]))))

(defn- parse-conjunction-condition
  [left tokens]
  (let [partial (parse-conditions tokens)]
    (if partial
      (let [[right remainder] partial]
        [(list 'and left right) remainder]))))

(defn- parse-conditions
  [tokens]
  (let [partial (parse-simple-condition tokens)]
    (if partial
      (let [[left [next & remainder]] partial]
        (cond
          (= next "and") (parse-conjunction-condition left remainder)
          (= next "or") (parse-disjunction-condition left remainder)
          true partial)))))

(defn- parse-left-hand-side
 [[IF & tokens]]
 (if
   (= IF "if")
   (parse-conditions tokens)))

(defn- parse-arithmetic-action
  [previous [prop1 SHOULD BE prop2 operator value & rest]]
  (cond
    (member? prop1 '("x" "y"))
    (throw
      (Exception. reserved-properties-error))
    (and (= SHOULD "should")
           (= BE "be")
           (member? operator '("+" "-" "*" "/")))
    [(list 'merge (or previous 'cell)
           {(keyword prop1) (list 'int
                                  (list (symbol operator) (list 'get-int 'cell (keyword prop2))
                                        (cond
                                          (re-matches re-number value) (read-string value)
                                          true (list 'get-int 'cell (keyword value)))))}) rest]))

(defn- parse-set-action
  [previous [property SHOULD BE value & rest]]
  (cond
    (member? property '("x" "y"))
    (throw
      (Exception. reserved-properties-error))
    (and (= SHOULD "should") (= BE "be"))
    [(list 'merge (or previous 'cell)
           {(keyword property) (cond (re-matches re-number value) (read-string value) true (keyword value))}) rest]))

(defn- parse-simple-action [previous tokens]
  (or (parse-arithmetic-action previous tokens)
      (parse-set-action previous tokens)))

(defn- parse-actions
  [previous tokens]
  (let [[left remainder] (parse-simple-action previous tokens)]
    (cond left
          (cond (= (first remainder) "and")
                (parse-actions left (rest remainder))
                true (list left)))))

(defn- parse-probability
  [previous [n CHANCE IN m & tokens]]
  (cond
    (and (= CHANCE "chance")(= IN "in"))
    (let [[action remainder] (parse-actions previous tokens)]
      (cond action
        [(list 'cond
              (list '<
                    (list 'rand
                          (first (parse-simple-value (list m) true)))
                    (first (parse-simple-value (list n) true)))
              action) remainder]))))

(defn- parse-right-hand-side
  [[THEN & tokens]]
  (if (= THEN "then")
    (or
      (parse-probability nil tokens)
      (parse-actions nil tokens))))

(defn parse-rule
  [line]
  (cond
   (string? line)
   (let [rule (parse-rule (split (triml line) #"\s+"))]
     (cond rule rule
       true (throw (Exception. (format bad-parse-error line)))))
   true
   (let [[left remainder] (parse-left-hand-side line)
              [right junk] (parse-right-hand-side remainder)]
     (cond
       ;; there should be a valide left hand side and a valid right hand side
       ;; there shouldn't be anything left over (junk should be empty)
       (and left right (empty? junk))
       (list 'fn ['cell 'world] (list 'if left right))))))

(defn compile-rule
  ([rule-text return-tuple?]
    (do
      (use 'mw-engine.utils)
      (let [afn (eval (parse-rule rule-text))]
        (cond
          (and afn return-tuple?)(list afn (trim rule-text))
          true afn))))
  ([rule-text]
    (compile-rule rule-text false)))

(ns ^{:doc 
      :author "Simon Brooke"}
  mw-parser.bulk
  (:use mw-parser.core
        mw-engine.utils
        clojure.java.io
        [clojure.string :only [split trim]])
  (:import (java.io BufferedReader StringReader)))

(defn comment?
  [line]
  (or (empty? (trim line)) (member? (first line) '(nil \# \;))))

(defn parse-string
  [string]
        ;; TODO: tried to do this using with-open, but couldn't make it work.
  (map #(parse-rule (trim %)) (remove comment? (split string #"\n"))))

(defn parse-file
  [filename]
  (parse-string (slurp filename)))

(defn compile-string
  [string]
  (map #(compile-rule % true) (remove comment? (split string #"\n"))))

(defn compile-file
  [filename]
  (compile-string (slurp filename)))

(ns ^{:doc 
      :author "Simon Brooke"}
  mw-parser.simplify
  (:require [mw-engine.utils :refer [member?]]))

(declare simplify)

(defn simplify-qualifier
  [tree]
  (cond
    (empty? tree) nil
    (and (coll? tree)
         (member? (first tree) '(:EQUIVALENCE :COMPARATIVE))) tree
    (coll? (first tree)) (or (simplify-qualifier (first tree))
                             (simplify-qualifier (rest tree)))
    (coll? tree) (simplify-qualifier (rest tree))
    true tree))

(defn simplify-second-of-two
  [tree]
  (if (= (count tree) 2) (simplify (nth tree 1)) tree))

(defn simplify-quantifier
  [tree]
  (if (number? (second tree)) [:COMPARATIVE '= (second tree)] (simplify (second tree))))

(defn simplify
  [tree]
  (if
    (coll? tree)
    (case (first tree)
      :ACTION (simplify-second-of-two tree)
      :ACTIONS (cons (first tree) (simplify (rest tree)))
      :CHANCE-IN nil
      :COMPARATIVE (simplify-second-of-two tree)
      :CONDITION (simplify-second-of-two tree)
      :CONDITIONS (simplify-second-of-two tree)
      :EXPRESSION (simplify-second-of-two tree)
      :PROPERTY (simplify-second-of-two tree)
      :PROPERTY-CONDITION-OR-EXPRESSION (simplify-second-of-two tree)
      :SPACE nil
      :THEN nil
      :AND nil
      :VALUE (simplify-second-of-two tree)
      (remove nil? (map simplify tree)))
    tree))

(ns ^{:doc 
      :author "Simon Brooke"}
  mw-parser.utils)

(defn rule?
  [maybe-rule]
  (and (coll? maybe-rule) (= (first maybe-rule) :RULE)))

(defn TODO
  [message]
  message)

(defn suitable-fragment?
  [tree-fragment type]
  (and (coll? tree-fragment)
       (= (first tree-fragment) type)))

(defn assert-type
  [tree-fragment type]
  (assert (suitable-fragment? tree-fragment type)
          (throw (Exception. (format "Expected a %s fragment" type)))))

(defn search-tree
  [tree tag]
  (cond
    (= (first tree) tag) tree
    :else (first
            (remove nil?
                    (map
                      #(search-tree % tag)
                      (rest tree))))))