Permalink
Browse files

Implemented precedence rules.

  • Loading branch information...
1 parent 439fed7 commit cf3751e1852db958f013fcb088f31c1db68b5d22 @aroemers committed Nov 7, 2012
View
@@ -0,0 +1,2 @@
+#!/bin/sh
+wc -l `find . | grep .clj`
@@ -2,14 +2,14 @@
import gluer.Adapter;
import test.modela.A;
-import test.modelb.B;
+import test.modelb.TwiceB;
@Adapter
public class TwiceBtoA1 implements A {
- private B adaptee;
+ private TwiceB adaptee;
- public TwiceBtoA1(B adaptee) {
+ public TwiceBtoA1(TwiceB adaptee) {
this.adaptee = adaptee;
}
@@ -2,14 +2,14 @@
import gluer.Adapter;
import test.modela.A;
-import test.modelb.B;
+import test.modelb.TwiceB;
@Adapter
public class TwiceBtoA2 implements A {
- private B adaptee;
+ private TwiceB adaptee;
- public TwiceBtoA2(B adaptee) {
+ public TwiceBtoA2(TwiceB adaptee) {
this.adaptee = adaptee;
}
@@ -0,0 +1,29 @@
+package test.adapter;
+
+import gluer.Adapter;
+import test.modela.A;
+import test.modelb.TwiceB;
+
+@Adapter
+public class TwiceBtoA3 implements A {
+
+ private TwiceB adaptee;
+
+ public TwiceBtoA3(TwiceB adaptee) {
+ this.adaptee = adaptee;
+ }
+
+ public void superSuperAMethod() {
+ System.out.println("{test.adapter.TwiceBtoA3} How to implement this?");
+ }
+
+ public void superAMethod() {
+ System.out.println("{test.adapter.TwiceBtoA3} Forwarding call to superBMethod.");
+ adaptee.superBMethod();
+ }
+
+ public void aMethod() {
+ System.out.println("{test.adapter.TwiceBtoA3} Forwarding call to bMethod.");
+ adaptee.bMethod();
+ }
+}
@@ -4,4 +4,7 @@ associate field test.Main.superA with call test.modelb.ModelFactory.get()
associate field test.Main.superSuperA with single test.modelb.SubSubB using test.adapter.BtoA$BtoA_Inner
+
+declare precedence test.adapter.TwiceBtoA1 over test.adapter.TwiceBtoA2
+
associate field test.Main.twice with new test.modelb.TwiceB
View
@@ -110,7 +110,9 @@
;; No parse errors, so build the libraries and initialise the agent.
(let [file-associations (r/parsed-associations parsed)
transformation-library (build-transformation-library file-associations)
- adapter-library (r/build-adapter-library)
+ file-precedences (r/parsed-precedences parsed)
+ precedence-relations (r/build-precedence-relations file-precedences)
+ adapter-library (assoc (r/build-adapter-library) :precedence precedence-relations)
transformer (transformer transformation-library)]
(log-verbose "Transformation library:" transformation-library)
(log-verbose "Adapter library:" adapter-library)
View
@@ -55,7 +55,7 @@
[issues type]
(let [prefix ({:warning "Warning" :error "Error"} type)]
(doseq [issue issues]
- (println (format "%s: %s" prefix issue)))))
+ (println (format "%s: %s" prefix issue) "\n"))))
(defn- do-check ;--- This do-check approach could also be solved using monads.
"This function can be wrapped around another function. If the returned value
@@ -77,17 +77,32 @@
"The main check function that directs the checking process."
[gluer-file-names]
(try
- (let [_ (log-verbose "Looking up Adapters...")
+ (let [_ (log-verbose "Looking up Adapters...")
adapter-library (r/build-adapter-library)
- _ (log-verbose "Adapter library:" adapter-library)
- _ (log-verbose "Checking adapter library data..." adapter-library)
+ _ (log-verbose "Adapter library:" adapter-library)
+
+ _ (log-verbose "Checking adapter library data...")
_ (do-check (l/check-adapter-library adapter-library))
- _ (log-verbose "Parsing .gluer files...")
+
+ _ (log-verbose "Parsing .gluer files...")
parsed-files (r/parse-gluer-files gluer-file-names)
- _ (log-verbose "Parsed .gluer files:" parsed-files)
- _ (log-verbose "Checking parsed .gluer files data...")
- _ (do-check (l/check-gluer-files parsed-files adapter-library))
- _ (log-verbose "Done checking.")]
+ _ (log-verbose "Parsed .gluer files:" parsed-files)
+ _ (log-verbose "Checking for parse errors...")
+ _ (do-check (l/check-parse-results parsed-files))
+
+ _ (log-verbose "Checking precedence declarations...")
+ parsed-precedences (r/parsed-precedences parsed-files)
+ _ (do-check (l/check-precedences parsed-precedences adapter-library))
+
+ _ (log-verbose "Building precedence relations...")
+ precedence-relations (r/build-precedence-relations parsed-precedences)
+ _ (log-verbose "Precedence relations:" precedence-relations)
+ _ (log-verbose "Checking associations...")
+ adapter-library (assoc adapter-library :precedence precedence-relations)
+ parsed-associations (r/parsed-associations parsed-files)
+ _ (do-check (l/check-associations parsed-associations adapter-library))
+
+ _ (log-verbose "Done checking.")]
(println "No errors."))
(catch InterruptedException ex
(println "Errors detected. Fix above errors and re-run the check."))))
View
@@ -22,7 +22,11 @@
"No suitable Adapter found for adapting %s to %s.")
(def resolution-conflict-error
- "Resolution conflict for adapting %s to %s. Eligible adapters are %s")
+ (str "Resolution conflict for adapting %s to %s.\n"
+ "\tConflicting adapters are: %s.\n"
+ "\tThe closest adapters are: %s.\n"
+ "\tAdd a 'using' clause to the association, or declare precedence rules "
+ "for the closest adapters."))
(def not-found-error
"Adapter %s is not found. Make sure it is spelled correctly and is in the classpath.")
@@ -90,8 +94,12 @@
`to-name', and an adapter library, an adapter name is returned that is eligible
and closest to the supplied types. See `eligible-adapters' and `closest-adapters'
for more info on this. The adapter name is return in a map with key :result.
- If no suitable adapter is found, or a resolution error occured, the map
- contain an :error key."
+ If no suitable adapter is found, or a resolution conflict occured, the map
+ contains an :error key.
+
+ Note that this function expects the adapter-library to hold a :precedence key,
+ which value should contain the map with precedence-relations as given by the
+ `gluer.resources/build-precedence-relations' function."
[from-name to-name adapter-library]
(let [eligible (eligible-adapters from-name to-name adapter-library)]
(cond
@@ -103,8 +111,15 @@
(let [closest (closest-adapters from-name to-name eligible)]
(if (= 1 (count closest))
{:result (ffirst closest)}
- {:error (format resolution-conflict-error from-name to-name
- (apply str (interpose ", " (map first closest))))})))))
+ (let [precedence-relations (:precedence adapter-library)
+ closest-names (set (keys closest))
+ preferred (remove #(some closest-names (precedence-relations %)) closest-names)]
+ (if (= 1 (count preferred))
+ {:result (first preferred)}
+ {:error (format resolution-conflict-error from-name to-name
+ (apply str (interpose ", " preferred))
+ (apply str (interpose ", " closest-names))
+ (apply str (interpose ", " (keys eligible))))})))))))
;;; Checking utilities.
@@ -131,7 +146,7 @@
;;; Adapter checking functions.
-(defn check-adapter-library
+(defn check-adapter-library ;--- TODO: Check for possible resolution conflicts.
"This function checks the adapter library for consistency. A map is returned,
with possibly a :warnings key and/or an :errors key. The values of those keys
consist of (possibly empty) sequences."
@@ -164,7 +179,7 @@
(defn- check-association
"This function checks a single filename-association pair. It checks the
individual clauses and, if no issues were found, continues to check the whole
- association regarding finding a suitable adapter. The functions returns a map
+ association regarding finding a suitable adapter. The function returns a map
in the following form:
{:warnings (\"Some warning\")
@@ -205,9 +220,14 @@
{:errors (when error [(format-issue error file-name (line-nr where))])
:warnings (when warning [(format-issue warning file-name (line-nr where))])}))))))
-(defn- check-overlaps
+(defn- check-association-overlaps
"This functions checks all filename-association pairs for overlap conflicts.
- The return value is a (possibly empty) sequence with error messages."
+ The function returns a map in the following form:
+
+ {:warnings (\"Some warning\")
+ :errors (\"Some error\" \"Another error\")}
+
+ The map values may be empty, which means no warnings and/or errors."
[file-associations]
;; Loop through the associations, and check overlap with all the other associations AFTER it.
;; This way, no two associations are checked twice.
@@ -220,28 +240,70 @@
this-file (line-nr this-assoc) that-file (line-nr that-assoc)
error-msg)))]
(recur (rest associations) (concat errors-accum errors)))
- (remove nil? errors-accum))))
-
-(defn- check-valid-files
- "Given a collection of succesfully parsed files and a valid adapter library,
- this function will check all associations. The return value is a merged map of
- all the results given by the 'check-association' function."
- [valid-files adapter-library]
- ;; The symbol file-associations will refer to a single sequence of filename-association pairs.
- (let [file-associations (r/parsed-associations valid-files)
- individual-check-results (map #(check-association % adapter-library) file-associations)
- overlap-check-results (check-overlaps file-associations)]
- ;; Merge all the {:errors [..] :warnings [..]} maps, and add the overlap errors to it.
- (-> (reduce (partial merge-with concat) individual-check-results)
- (update-in [:errors] concat overlap-check-results))))
-
-(defn check-gluer-files
- "Given the parse results of the gluer files (as returned by
- `gluer.resources/parse-gluer-files'), this function checks for warnings and
- errors in them. Parse errors are reported as well, and succesfully parsed
- files will be checked (even if other files have parse errors)."
- [parsed-gluer-files adapter-library]
- (let [{valid :succes failed :error} (group-by (comp ffirst :parsed) parsed-gluer-files)
- parse-errors (map #(str (get-in % [:parsed :file-name]) ": " (get-in % [:parsed :error])) failed)]
- (-> (check-valid-files valid adapter-library)
- (update-in [:errors] concat parse-errors))))
+ {:errors (remove nil? errors-accum)})))
+
+(defn check-associations
+ "Given a collection of file-association pairs, as returned by
+ `gluer.resources/parsed-associations', it will check each association. The
+ function returns a map in the following form:
+
+ {:warnings (\"Some warning\")
+ :errors (\"Some error\" \"Another error\")}
+
+ The map values may be empty, which means no warnings and/or errors."
+ [file-associations adapter-library]
+ (let [association-check-results (map #(check-association % adapter-library) file-associations)
+ association-overlap-results (check-association-overlaps file-associations)]
+ ;; Merge the {:errors [..] :warnings [..]} maps.
+ (reduce (partial merge-with concat)
+ (conj association-check-results association-overlap-results))))
+
+(defn- check-precedence
+ "This functions checks a single file-precedence pair, given an adapter
+ library. The function returns a map in the following form:
+
+ {:warnings (\"Some warning\")
+ :errors (\"Some error\" \"Another error\")}
+
+ The map values may be empty, which means no warnings and/or errors."
+ [[file-name precedence] adapter-library]
+ (let [higher-class-name (get-in precedence [:higher :class :word])
+ lower-class-name (get-in precedence [:lower :class :word])]
+ (->> (concat (when-not (adapter-library higher-class-name)
+ [(if (r/class-by-name higher-class-name)
+ (format not-adapter-error higher-class-name)
+ (format not-found-error higher-class-name))])
+ (when-not (adapter-library lower-class-name)
+ [(if (r/class-by-name lower-class-name)
+ (format not-adapter-error lower-class-name)
+ (format not-found-error lower-class-name))]))
+ (map #(format-issue % file-name (line-nr precedence)))
+ (hash-map :errors))))
+
+(defn check-precedences
+ "Given a collection of file-precedence pairs, as returned by
+ `gluer.resources/parsed-precedences', it will check each precedence
+ declaration. The function returns a map in the following form:
+
+ {:warnings (\"Some warning\")
+ :errors (\"Some error\" \"Another error\")}
+
+ The map values may be empty, which means no warnings and/or errors."
+ [file-precedences adapter-library]
+ (let [precedence-check-results (map #(check-precedence % adapter-library) file-precedences)]
+ ;; Merge the {:errors [..] :warnings [..]} maps.
+ (reduce (partial merge-with concat) precedence-check-results)))
+
+(defn check-parse-results
+ "Given the parse results by `gluer.resources/parse-gluer-files', this checks
+ if some of the files failed to parse. The function returns a map in the
+ following form:
+
+ {:warnings (\"Some warning\")
+ :errors (\"Some error\" \"Another error\")}
+
+ The map values may be empty, which means no warnings and/or errors."
+ [parsed-gluer-files]
+ (let [failed (filter (comp :error :parsed) parsed-gluer-files)]
+ {:errors (map #(str (get-in % [:parsed :file-name]) ": " (get-in % [:parsed :error]))
+ failed)}))
@@ -119,7 +119,7 @@
(or (= this that) ((apply union (leveled-supertypes-of this)) that)))
-;;; Building the adapter library.
+;;; Building the adapter library and precedence relations.
(defn build-adapter-library
"Based on a collection of fully qualified class names, this functions returns
@@ -152,6 +152,24 @@
:adapts-to adapts-to}}))
(apply merge)))
+(defn build-precedence-relations
+ "Given a collection of filename-precedence pairs (as given by the
+ `parsed-precedences' function), return a map where the keys are those
+ adapter class-names that are preceded by other adapters. The value of such a
+ key is a set with class-names that have precedence over that particular
+ adapter. For example:
+
+ {\"preceded.Adapter\" #{\"by.some.preferred.Adapter\" \"and.ByThis\"}
+ ...}"
+ [file-precedences]
+ (loop [precedences (map second file-precedences)
+ accum {}]
+ (if-let [precedence (first precedences)]
+ (let [higher (get-in precedence [:higher :class :word])
+ lower (get-in precedence [:lower :class :word])]
+ (recur (rest precedences) (update-in accum [lower] #(set (conj % higher)))))
+ accum)))
+
;;; Parsing the .gluer files and building the association library
@@ -220,11 +238,11 @@
Unsuccesfully parsed files are ignored."
[parse-result k]
- (for [{:keys [file-name parsed]} parse-result
- :let [toplevel (get-in parsed [:succes :root :toplevel])
- filtered (remove nil? (map k toplevel))]
- item filtered]
- [file-name item]))
+ (set (for [{:keys [file-name parsed]} parse-result
+ :let [toplevel (get-in parsed [:succes :root :toplevel])
+ filtered (remove nil? (map k toplevel))]
+ item filtered]
+ [file-name item])))
(defn parsed-associations
"Given the parse result as given by the `parse-gluer-files' function, returns
@@ -253,17 +271,3 @@
Unsuccesfully parsed files are ignored."
[parse-result]
(toplevel-items parse-result :precedence))
-
-; (defn build-association-library
-; "Given a collection of parse-trees of .gluer files according to the `rules'
-; above (including the :succes key), returns a set of associations found in all
-; of the parse trees."
-; [parsed-gluer-files]
-; (toplevel-items parsed-gluer-files :association))
-
-; (defn build-precedence-library
-; "Given a collection of parse-trees of .gluer files according to the `rules'
-; above (including the :succes key), returns a set of precedende declarations
-; found in all of the parse trees."
-; [parsed-gluer-files]
-; (toplevel-items parsed-gluer-files :precedence))

0 comments on commit cf3751e

Please sign in to comment.