diff options
-rw-r--r-- | Pesto.cabal | 4 | ||||
-rw-r--r-- | src/Codec/Pesto/Dot.lhs | 1 | ||||
-rw-r--r-- | src/Codec/Pesto/Graph.lhs | 15 | ||||
-rw-r--r-- | src/Codec/Pesto/Lint.lhs | 29 | ||||
-rw-r--r-- | src/Codec/Pesto/Parse.lhs | 10 | ||||
-rw-r--r-- | src/Codec/Pesto/Serialize.lhs | 2 |
6 files changed, 31 insertions, 30 deletions
diff --git a/Pesto.cabal b/Pesto.cabal index ee349e7..b42c491 100644 --- a/Pesto.cabal +++ b/Pesto.cabal @@ -22,12 +22,14 @@ library build-depends: base >=4.6 && <4.7, HUnit, parsec hs-source-dirs: src default-language: Haskell2010 + ghc-options: -Werror -Wall -fno-warn-missing-signatures executable pesto main-is: Main.lhs hs-source-dirs: src default-language: Haskell2010 build-depends: base >=4.6 && <4.7, HUnit, parsec + ghc-options: -Werror -Wall -fno-warn-missing-signatures test-suite pesto-test type: exitcode-stdio-1.0 @@ -35,10 +37,12 @@ test-suite pesto-test hs-source-dirs: src default-language: Haskell2010 build-depends: base >=4.6 && <4.7, Pesto, HUnit, parsec + ghc-options: -Werror -Wall -fno-warn-missing-signatures executable pesto-doc main-is: Doc.lhs hs-source-dirs: src default-language: Haskell2010 build-depends: base >=4.6 && <4.7, pandoc >=1.14, highlighting-kate, blaze-html, filepath, containers + ghc-options: -Werror -Wall -fno-warn-missing-signatures diff --git a/src/Codec/Pesto/Dot.lhs b/src/Codec/Pesto/Dot.lhs index a0ac161..89439e0 100644 --- a/src/Codec/Pesto/Dot.lhs +++ b/src/Codec/Pesto/Dot.lhs @@ -15,7 +15,6 @@ image, for example. > f (a, b) = show a ++ " -> " ++ show b ++ ";" > e = map f edges > n = map (\(a, b) -> show a ++ " [label=\"" ++ dotEncodeString (serialize b) ++ "\"];") nodes -> addcolor = "#e6ee9c" > dotEncodeString = concatMap dotEncodeChar > dotEncodeChar '\n' = "\\n" diff --git a/src/Codec/Pesto/Graph.lhs b/src/Codec/Pesto/Graph.lhs index 3d28390..ed02b50 100644 --- a/src/Codec/Pesto/Graph.lhs +++ b/src/Codec/Pesto/Graph.lhs @@ -20,7 +20,7 @@ Language semantics > , Edge > , Edges > ) where -> import Data.Char (isSpace, toLower, isLetter) +> import Data.Char (toLower) > import Data.List (sort, nub) > import Test.HUnit hiding (test, Node) > import Control.Applicative ((<$>)) @@ -39,7 +39,7 @@ This function extracts all recipes from the stream and removes both directives. > isEnd (Directive x) | x `elem` ["bonappetit", "pesto"] = True > isEnd _ = False > (between, next) = break isEnd stream -> extract (x:xs) = extract xs +> extract (_:xs) = extract xs Start and end directive are removed from the extracted instructions. The directive “bonappetit” is optional at the end of a stream. @@ -72,9 +72,8 @@ actions on them, put them aside and add them again. This function processes a list of nodes, that is instructions uniquely identified by an integer and returns the edges of the directed graph as a list of tuples. -> toGraph nodes = edges +> toGraph nodes = third $ foldl f (Nothing, [[]], []) nodes > where -> (_, _, edges) = foldl f (Nothing, [[]], []) nodes Ingredients are simply added to the current workspace. They should for example appear on the shopping list. @@ -91,6 +90,7 @@ Actions take all ingredients and tools currently on the workspace, perform some action with them and put the product back onto the workspace. > f (_, stack:sx, edges) (i, Action _) = (Just i, [i]:stack:sx, edgesTo i stack ++ edges) +> f (_, [], _) (_, Action _) = undefined -- never reached Results add a label to the current workspace’s contents and move them out of the way. It should be a meaningful name, not just A and B obviously. @@ -116,7 +116,7 @@ Annotations add a description to any of the previous instructions. They can be used to provide more information about ingredients (so “hot water” becomes “+water (hot)”, tools (“&oven (200 °C)”) or actions (“[cook] (XXX)”). -> f ctx@(Nothing, s, edges) (_, Annotation _) = ctx +> f ctx@(Nothing, _, _) (_, Annotation _) = ctx > f (Just prev, s, edges) (i, Annotation _) = (Just prev, s, (i, prev):edges) Unused directives or unknown instructions are danging nodes with no connection to @@ -128,6 +128,7 @@ other nodes. These are helper functions: > addToStack (_, stack:sx, edges) i = (Just i, (i:stack):sx, edges) +> addToStack (_, [], _) _ = undefined -- never reached > consumeStack (_, s, edges) i = > let > stack = dropWhile null s @@ -208,7 +209,7 @@ to the reference in question is created. > isTarget dest (_, Result x) = lc x == lc dest > isTarget dest (_, Alternative x) = lc x == lc dest > isTarget _ _ = False - +> findTarget _ _ = [] References works before or after the result instruction. @@ -267,3 +268,5 @@ Get all nodes with edges pointing towards nodeid > test = ["graph" ~: testGraph, "ref" ~: testRef, "extract" ~: testExtract] +> third (_, _, x) = x + diff --git a/src/Codec/Pesto/Lint.lhs b/src/Codec/Pesto/Lint.lhs index becae57..76253e8 100644 --- a/src/Codec/Pesto/Lint.lhs +++ b/src/Codec/Pesto/Lint.lhs @@ -6,11 +6,9 @@ Linting > module Codec.Pesto.Lint (lint, test, parseMetadata, extractMetadata) where > import Test.HUnit hiding (test, Node) > import Data.List (sort, isPrefixOf) -> import Control.Applicative ((<*>), (<$>), (<*), (*>)) +> import Control.Applicative ((<*>), (<$>), (*>)) > import Control.Monad (liftM) > import Text.Parsec hiding (parse) -> import Text.Parsec.Char -> import Data.Maybe (mapMaybe) > import Data.Char (isSpace) > > import Codec.Pesto.Graph hiding (test) @@ -40,7 +38,7 @@ dangling. > rootIsResult nodes edges = case walkRoot nodes edges of > [] -> [LintResult NoRootNode []] -> (i, Result _):[] -> [] +> (_, Result _):[] -> [] > (i, _):[] -> [LintResult NonResultRootNode [i]] > xs -> [LintResult MoreThanOneRootNode (map fst xs)] @@ -182,9 +180,9 @@ By definition time is a tool and not an ingredient. > isTime (Quantity _ unit "") | unit `elem` timeUnits = True > isTime _ = False -> timeIsATool nodes edges = foldl f [] nodes +> timeIsATool nodes _ = foldl f [] nodes > where -> f xs n@(nodeid, Ingredient q) | isTime q = LintResult TimeIsATool [nodeid]:xs +> f xs (nodeid, Ingredient q) | isTime q = LintResult TimeIsATool [nodeid]:xs > f xs _ = xs > testLintQuantity = [ @@ -225,11 +223,11 @@ may be used with each of them: m (milli-), c (centi-), d (dezi-) and k (kilo Additionally time in s (second), min (minute), h (hour), d (day) should be accepted. -> wellKnownUnit nodes edges = foldl f [] nodes +> wellKnownUnit nodes _ = foldl f [] nodes > where -> f xs n@(nodeid, Ingredient q) | (not . known) q = +> f xs (nodeid, Ingredient q) | (not . known) q = > LintResult UnitNotWellKnown [nodeid]:xs -> f xs n@(nodeid, Tool q) | (not . known) q = +> f xs (nodeid, Tool q) | (not . known) q = > LintResult UnitNotWellKnown [nodeid]:xs > f xs _ = xs > known (Quantity _ unit _) = unit `elem` knownUnits @@ -339,11 +337,11 @@ Ranges The first amount of a range ratio must be strictly smaller than the second. This limitation is not enforced for ranges containing strings. -> rangeFromLargerThanTo nodes edges = foldl f [] nodes +> rangeFromLargerThanTo nodes _ = foldl f [] nodes > where -> f xs n@(nodeid, Ingredient q) | not $ rangeOk q = +> f xs (nodeid, Ingredient q) | not $ rangeOk q = > LintResult RangeFromLargerThanTo [nodeid]:xs -> f xs n@(nodeid, Reference q) | not $ rangeOk q = +> f xs (nodeid, Reference q) | not $ rangeOk q = > LintResult RangeFromLargerThanTo [nodeid]:xs > f xs _ = xs > rangeOk (Quantity (Range (AmountRatio a) (AmountRatio b)) _ _) = a < b @@ -360,7 +358,6 @@ This limitation is not enforced for ranges containing strings. Appendix ++++++++ -> type LintTest a = Nodes a -> Edges -> [LintResult] > data LintResult = LintResult LintStatus [NodeId] deriving (Show, Eq, Ord) > data LintStatus = > NoRootNode @@ -393,15 +390,15 @@ Every lint test checks a single aspect of the graph. > , rangeFromLargerThanTo > ] -> withGraph doc f = f doc nodes edges +> withGraph doc f = f nodes edges > where > (Right op) = (head . extract . snd . unzip) <$> parse ("%pesto " ++ doc) > nodes = zip [firstNodeId..] op > edges = toGraph nodes ++ resolveReferences nodes -> cmpLint doc expect = withGraph doc (\doc nodes edges -> doc ~: sort (lint nodes edges) ~?= sort expect) +> cmpLint doc expect = withGraph doc (\nodes edges -> doc ~: sort (lint nodes edges) ~?= sort expect) -> cmpLintMeta doc expectLint expectMeta = withGraph doc (\doc nodes edges -> doc ~: [ +> cmpLintMeta doc expectLint expectMeta = withGraph doc (\nodes edges -> doc ~: [ > sort (lint nodes edges) ~?= sort expectLint > , liftM sort (extractMetadata nodes edges) ~?= liftM sort expectMeta > ]) diff --git a/src/Codec/Pesto/Parse.lhs b/src/Codec/Pesto/Parse.lhs index 0d4e981..d411906 100644 --- a/src/Codec/Pesto/Parse.lhs +++ b/src/Codec/Pesto/Parse.lhs @@ -8,8 +8,8 @@ Language syntax > , test > , Instruction(..) > , Quantity(..) -> , Unit(..) -> , Object(..) +> , Unit +> , Object > , Approximately(..) > , Amount(..) > , isResult @@ -23,13 +23,11 @@ Language syntax > , notspace > ) where > import Control.Applicative ((<*>), (<$>), (<*), (*>)) -> import Data.Char (isSpace, toLower, isLetter) +> import Data.Char (isSpace) > import Data.Ratio ((%)) > import Text.Parsec hiding (parse) -> import Text.Parsec.Char > import Text.ParserCombinators.Parsec.Pos (newPos) -> import Text.ParserCombinators.Parsec.Error (ParseError, Message, -> errorMessages, messageEq, newErrorUnknown) +> import Text.ParserCombinators.Parsec.Error (newErrorUnknown) > import Test.HUnit hiding (test) > > import Codec.Pesto.Serialize (serialize) diff --git a/src/Codec/Pesto/Serialize.lhs b/src/Codec/Pesto/Serialize.lhs index 6b99b4b..56babb4 100644 --- a/src/Codec/Pesto/Serialize.lhs +++ b/src/Codec/Pesto/Serialize.lhs @@ -4,7 +4,7 @@ Serializing .. class:: nodoc > module Codec.Pesto.Serialize (serialize) where -> import Data.Char (isSpace, toLower, isLetter) +> import Data.Char (isSpace, isLetter) > import Data.Ratio (numerator, denominator) > > import {-# SOURCE #-} Codec.Pesto.Parse |