lint: Add uniqueness test for Results/Alternatives

1 files changed, 30 insertions, 2 deletions

diff --git a/src/lib/Codec/Pesto/Lint.lhs b/src/lib/Codec/Pesto/Lint.lhs
index 900a700..480d161 100644
--- a/src/lib/Codec/Pesto/Lint.lhs
+++ b/src/lib/Codec/Pesto/Lint.lhs
@@ -12,11 +12,12 @@ Linting
 > 	, Metadata(..)
 > 	, LintResult(..)) where
 > import Test.HUnit hiding (test, Node)
-> import Data.List (sort, isPrefixOf)
+> import Data.List (sort, isPrefixOf, insert)
 > import Text.Parsec hiding (parse)
-> import Data.Char (isSpace)
+> import Data.Char (isSpace, toLower)
 > import Data.Ratio ((%))
 > import Data.Maybe (fromMaybe)
+> import qualified Data.Map.Strict as M
 >
 > import Codec.Pesto.Graph hiding (test)
 > import Codec.Pesto.Parse hiding (test)
@@ -281,6 +282,30 @@ all results and alternatives are referenced at some point.
 > 	, cmpLint "*foobar >foo" [LintResult UndefinedReference [0]]
 > 	]
 
+Results and alternatives must not have duplicate names, so collect
+their lower-case object names into map and flag those, which reference
+multiple nodes.
+
+> uniqueNames nodes _ = M.foldl f [] nameMap
+> 	where
+> 		f xs fnodes | length fnodes > 1 = LintResult DuplicateReferenceName fnodes:xs
+> 		f xs _ = xs
+> 		nameMap = foldl buildMap M.empty nodes
+> 		buildMap m (nodeid, Result qty) = M.insertWith append (getObject qty) [nodeid] m
+> 		buildMap m (nodeid, Alternative qty) = M.insertWith append (getObject qty) [nodeid] m
+> 		buildMap m _ = m
+> 		getObject (Quantity _ _ object) = map toLower object
+> 		append [a] b = insert a b
+> 		append _ _ = error "unreachable"
+
+> testUniqueNames = [
+> 	  cmpLint "+a >x +b >y *x *y >foo" []
+> 	, cmpLint "+a >x +b >x *x >y" [LintResult DuplicateReferenceName [1, 3]]
+> 	, cmpLint "+a >x +b +c |x *x >y" [LintResult DuplicateReferenceName [1, 4]]
+> 	, cmpLint "+a >1 _ foo +a >2 _ FOO +a >3 _ foO *Foo >y"
+> 		[LintResult DuplicateReferenceName [1, 3, 5]]
+> 	]
+
 A result must have at least one incoming edge. This is a special case and can
 only occur at the beginning of a recipe.
 
@@ -344,6 +369,7 @@ Appendix
 > 	| NonResultRootNode
 > 	| MoreThanOneRootNode
 > 	| UndefinedReference
+> 	| DuplicateReferenceName
 > 	| TooFewChildren
 >	| TimeIsATool
 > 	| TimeAnnotatesAction
@@ -361,6 +387,7 @@ Every lint test checks a single aspect of the graph.
 > lintTests = [
 > 	  rootIsResult
 >	, referencesResolved
+> 	, uniqueNames
 >	, resultNonempty
 >	, twoAlternatives
 > 	, timeIsATool
@@ -391,6 +418,7 @@ Every lint test checks a single aspect of the graph.
 > 	  testConnectivity
 > 	, testMetadata
 > 	, testLintRefs
+> 	, testUniqueNames
 > 	, testLintQuantity
 > 	, testLintWellKnownUnit
 > 	, testTimeAnnotatesAction