summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLars-Dominik Braun <lars@6xq.net>2015-08-13 11:51:57 +0200
committerLars-Dominik Braun <lars@6xq.net>2015-08-16 10:07:57 +0200
commit980ccb41e46df0c4909c3ac8f4c5a9a04661053f (patch)
tree8fe0639788d101ef479463d2b170fabde59f05da
parent32638a6ff1292360c1a59cc2f0a864cfea345cc6 (diff)
downloadpesto-980ccb41e46df0c4909c3ac8f4c5a9a04661053f.tar.gz
pesto-980ccb41e46df0c4909c3ac8f4c5a9a04661053f.tar.bz2
pesto-980ccb41e46df0c4909c3ac8f4c5a9a04661053f.zip
Add linting information to dot output
-rw-r--r--src/Codec/Pesto.lhs1
-rw-r--r--src/Codec/Pesto/Dot.lhs23
-rw-r--r--src/Codec/Pesto/Lint.lhs3
-rw-r--r--src/Main.lhs63
4 files changed, 50 insertions, 40 deletions
diff --git a/src/Codec/Pesto.lhs b/src/Codec/Pesto.lhs
index bf8e977..cf20105 100644
--- a/src/Codec/Pesto.lhs
+++ b/src/Codec/Pesto.lhs
@@ -233,7 +233,6 @@ See https://github.com/PromyLOPh/rezepte for example recipes.
.. include:: Pesto/Parse.lhs
.. include:: Pesto/Graph.lhs
.. include:: Pesto/Lint.lhs
-.. include:: Pesto/Dot.lhs
.. include:: Pesto/Serialize.lhs
Using this project
diff --git a/src/Codec/Pesto/Dot.lhs b/src/Codec/Pesto/Dot.lhs
deleted file mode 100644
index 89439e0..0000000
--- a/src/Codec/Pesto/Dot.lhs
+++ /dev/null
@@ -1,23 +0,0 @@
-Presentation
-------------
-
-.. class:: nodoc
-
-> module Codec.Pesto.Dot (toDot) where
-> import Codec.Pesto.Serialize (serialize)
-
-Since each recipe is just a directed graph (digraph), we can use the dot
-language to represent it as well. This in turnXXX can be transformed into an
-image, for example.
-
-> toDot nodes edges = unlines $ ["digraph a {\nnode [fontname=\"Roboto Semi-Light\"];"] ++ n ++ e ++ ["}"]
-> where
-> f (a, b) = show a ++ " -> " ++ show b ++ ";"
-> e = map f edges
-> n = map (\(a, b) -> show a ++ " [label=\"" ++ dotEncodeString (serialize b) ++ "\"];") nodes
-
-> dotEncodeString = concatMap dotEncodeChar
-> dotEncodeChar '\n' = "\\n"
-> dotEncodeChar '"' = "\\\""
-> dotEncodeChar x = [x]
-
diff --git a/src/Codec/Pesto/Lint.lhs b/src/Codec/Pesto/Lint.lhs
index ebeee44..ecfac79 100644
--- a/src/Codec/Pesto/Lint.lhs
+++ b/src/Codec/Pesto/Lint.lhs
@@ -7,7 +7,8 @@ Linting
> , test
> , parseMetadata
> , extractMetadata
-> , Metadata(..)) where
+> , Metadata(..)
+> , LintResult(..)) where
> import Test.HUnit hiding (test, Node)
> import Data.List (sort, isPrefixOf)
> import Control.Applicative ((<*>), (<$>), (*>))
diff --git a/src/Main.lhs b/src/Main.lhs
index bebdd30..1b257bd 100644
--- a/src/Main.lhs
+++ b/src/Main.lhs
@@ -4,17 +4,16 @@ User interface
.. class:: nodoc
> module Main (main) where
-> import System.IO (hPrint, stderr)
> import System.Environment (getArgs)
> import Data.List (intercalate)
+> import Data.Monoid ((<>), mconcat)
>
> import Codec.Pesto.Parse (parse, Instruction (Ingredient), Quantity (..))
> import Codec.Pesto.Graph (extract, toGraph, firstNodeId, resolveReferences)
-> import Codec.Pesto.Lint (lint, extractMetadata, Metadata(..))
-> import Codec.Pesto.Dot (toDot)
+> import Codec.Pesto.Lint (lint, extractMetadata, Metadata(..), LintResult (LintResult))
> import Codec.Pesto.Serialize (serialize)
-The user-interface has different modes of operation. All of read a single
+The user-interface has different modes of operation. All of them read a single
recipe from the standard input.
> main = do
@@ -22,6 +21,11 @@ recipe from the standard input.
> s <- getContents
> either malformedRecipe (run op) (parse s)
+> run "dot" = runDot
+> run "metadata" = runMeta
+> run "ingredients" = runIngredients
+> run _ = const (putStrLn "unknown operation")
+
> malformedRecipe = print
> streamToGraph stream = (nodes, edges)
@@ -33,27 +37,57 @@ recipe from the standard input.
dot
^^^
-Convert recipe into GraphViz’ dot language. Example:
+Since each recipe is just a directed graph (digraph), GraphViz’ dot language
+can represent recipes as well. Example:
.. code:: bash
cabal run --verbose=0 pesto dot < spaghetti.pesto | dot -Tpng > spaghetti.png
-.. class:: todo
-
-add linting information to graph
+> runDot stream = putStrLn $ toDot dotNodes dotEdges
+> where
+> (nodes, edges) = streamToGraph stream
+> maxId = (maximum $ map fst nodes) + 1
+> (lintNodes, lintEdges) = unzip $ map (uncurry lintToNodesEdges)
+> $ zip [maxId..] (lint nodes edges)
+> dotNodes = concat [
+> [("node", [("fontname", "Roboto Semi-Light")])]
+> , map (\(a, label) -> (show a, [("label", serialize label)])) nodes
+> , lintNodes
+> ]
+> dotEdges = concat [
+> map (both show) edges
+> , concat lintEdges
+> ]
+
+> lintToNodesEdges nodeid (LintResult t nodes) = let
+> n = (show nodeid, [("label", show t), ("color", "red")])
+> e = map (\i -> both show (nodeid, i)) nodes
+> in (n, e)
+
+> both f (a, b) = (f a, f b)
+
+> toDot nodes edges = "digraph a {"
+> <> mconcat (map nodeToDot nodes)
+> <> mconcat (map edgeToDot edges)
+> <> "}"
+> where
+> edgeToDot (a, b) = a <> " -> " <> b <> ";"
+> nodeToDot (a, b) = a <> " [" <> mconcat (mapToDot b) <> "];"
-> run "dot" stream = do
-> let (nodes, edges) = streamToGraph stream
-> hPrint stderr $ lint nodes edges
-> putStrLn $ toDot nodes edges
+> mapToDot = map kvToDot
+> kvToDot (k, v) = k <> "=\"" <> quoteString v <> "\""
+> quoteString s = mconcat $ map quoteChar s
+> quoteChar '\n' = "\\n"
+> quoteChar '"' = "\\\""
+> quoteChar x = [x]
metadata
^^^^^^^^
Print metadata as key-value pairs, separated by ``=``.
-> run "metadata" stream = maybe (return ()) (mapM_ printMeta) $ uncurry extractMetadata $ streamToGraph stream
+> runMeta stream = maybe (return ()) (mapM_ printMeta) $ uncurry extractMetadata $ streamToGraph stream
ingredients
^^^^^^^^^^^
@@ -61,11 +95,10 @@ ingredients
Extract ingredients and print them in CSV format. This does not take
alternatives into account yet.
-> run "ingredients" stream = mapM_ (putStrLn . csvQty) $ reverse $ foldl getIngredient [] stream
+> runIngredients stream = mapM_ (putStrLn . csvQty) $ reverse $ foldl getIngredient [] stream
> where
> getIngredient xs (_, Ingredient q) = q:xs
> getIngredient xs _ = xs
-> run _ _ = putStrLn "unknown operation"
> printMeta (_, (key, MetaStr value)) = putStrLn $ key ++ "=" ++ value
> printMeta (_, (key, MetaQty q)) = putStrLn $ key ++ "=" ++ csvQty q