From c03c0ff4437ba4c9169b6f240f062cd3df40a023 Mon Sep 17 00:00:00 2001
From: Lars-Dominik Braun <lars@6xq.net>
Date: Sun, 28 Aug 2022 13:50:28 +0200
Subject: lint: Add uniqueness test for Results/Alternatives

---
 Pesto.cabal                  |  2 +-
 src/lib/Codec/Pesto/Lint.lhs | 32 ++++++++++++++++++++++++++++++--
 2 files changed, 31 insertions(+), 3 deletions(-)

diff --git a/Pesto.cabal b/Pesto.cabal
index e72809d..bf85be4 100644
--- a/Pesto.cabal
+++ b/Pesto.cabal
@@ -15,7 +15,7 @@ cabal-version:       >=1.10
 -- parsec>=3.1.9 has instance Eq ParseError
 library
   exposed-modules:     Codec.Pesto, Codec.Pesto.Parse, Codec.Pesto.Graph, Codec.Pesto.Lint, Codec.Pesto.Serialize
-  build-depends:       base >=4.8, HUnit, parsec >= 3.1.9
+  build-depends:       base >=4.8, HUnit, parsec >= 3.1.9, containers
   hs-source-dirs:      src/lib
   default-language:    Haskell2010
   ghc-options:         -Werror -Wall -fno-warn-missing-signatures
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
-- 
cgit v1.2.3