summaryrefslogtreecommitdiff
path: root/src/lib
diff options
context:
space:
mode:
Diffstat (limited to 'src/lib')
-rw-r--r--src/lib/Codec/Pesto/Lint.lhs42
1 files changed, 39 insertions, 3 deletions
diff --git a/src/lib/Codec/Pesto/Lint.lhs b/src/lib/Codec/Pesto/Lint.lhs
index affea98..45e3ef6 100644
--- a/src/lib/Codec/Pesto/Lint.lhs
+++ b/src/lib/Codec/Pesto/Lint.lhs
@@ -12,7 +12,7 @@ Linting
> , Metadata(..)
> , LintResult(..)) where
> import Test.HUnit hiding (test, Node)
-> import Data.List (sort, isPrefixOf, insert)
+> import Data.List (sort, isPrefixOf, insert, intersect)
> import Text.Parsec hiding (parse)
> import Data.Char (isSpace, toLower)
> import Data.Ratio ((%))
@@ -54,7 +54,7 @@ Empty recipes or circular references have no root node:
> testConnectivity = [
> cmpLint "" [LintResult NoRootNode [], LintResult NoMetadata []]
> , cmpLint "*foobar >foobar"
-> [LintResult NoRootNode [], LintResult NoMetadata []]
+> [LintResult NoRootNode [], LintResult CircularLoop [0, 1], LintResult NoMetadata []]
> , cmpLint "+foobar"
> [LintResult NonResultRootNode [0], LintResult NoMetadata []]
@@ -278,7 +278,7 @@ all results and alternatives are referenced at some point.
> f xs _ = xs
> testLintRefs = [
-> cmpLint "*foobar >foobar >barbaz" []
+> cmpLint "*foobar >foobar >barbaz" [LintResult CircularLoop [0, 1]]
> , cmpLint "*foobar >foo" [LintResult UndefinedReference [0]]
> ]
@@ -336,6 +336,39 @@ make the alternative pointless.
> , cmpLint "+A &B |foo *foo >bar" []
> ]
+References cannot loop, because, well, you cannot cook something and
+use an ingredient you have not made yet. It is possible to branch out
+and merge again though if an ingredient is split into multiple parts
+and added to different outputs.
+
+> circularLoops nodes edges = map (LintResult CircularLoop) circles
+> where
+> allReferences = foldl referenceNodes [] nodes
+> referenceNodes xs (nodeid, Reference _) = nodeid:xs
+> referenceNodes xs _ = xs
+> circles = filter (not . null) $ map (visitIncoming [] . singleton) allReferences
+> singleton x = [x]
+> visitIncoming _ [] = []
+> visitIncoming visited next = case length (intersect visited nextNext) of
+> 0 -> visitIncoming nextVisited nextNext
+> _ -> nextVisited
+> where
+> nextVisited = visited ++ next
+> nextNext = map fst $ concat $ map (incomingNodes nodes edges) next
+
+> testLintCircularLoops = [
+> cmpLint "*y >x *x >y >foobar"
+> [LintResult CircularLoop [0, 3, 2, 1] , LintResult CircularLoop [2, 1, 0, 3]]
+> , cmpLint "*z >x *x >y *y >z *z >foobar" [
+> LintResult CircularLoop [0, 5, 4, 3, 2, 1]
+> , LintResult CircularLoop [2, 1, 0, 5, 4, 3]
+> , LintResult CircularLoop [4, 3, 2, 1, 0, 5]
+> , LintResult CircularLoop [6, 5, 4, 3, 2, 1, 0]
+> ]
+> , cmpLint "+a >foobar *1/2 _ foobar >x *1/2 _ foobar >y *x *y >final" []
+> , cmpLint "+a >foobar *1/2 _ foobar >x *x *1/2 _ foobar >final" []
+> ]
+
Ranges
++++++
@@ -370,6 +403,7 @@ Appendix
> | MoreThanOneRootNode
> | UndefinedReference
> | DuplicateReferenceName
+> | CircularLoop
> | TooFewChildren
> | TimeIsATool
> | TimeAnnotatesAction
@@ -388,6 +422,7 @@ Every lint test checks a single aspect of the graph.
> rootIsResult
> , referencesResolved
> , uniqueNames
+> , circularLoops
> , resultNonempty
> , twoAlternatives
> , timeIsATool
@@ -419,6 +454,7 @@ Every lint test checks a single aspect of the graph.
> , testMetadata
> , testLintRefs
> , testUniqueNames
+> , testLintCircularLoops
> , testLintQuantity
> , testLintWellKnownUnit
> , testTimeAnnotatesAction