diff options
Diffstat (limited to 'src/lib')
| -rw-r--r-- | src/lib/Codec/Pesto/Lint.lhs | 42 |
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 |