diff options
Diffstat (limited to 'src/exe')
| -rw-r--r-- | src/exe/Doc.lhs | 65 | ||||
| -rw-r--r-- | src/exe/Main.lhs | 110 | ||||
| -rw-r--r-- | src/exe/Test.lhs | 22 | 
3 files changed, 197 insertions, 0 deletions
| diff --git a/src/exe/Doc.lhs b/src/exe/Doc.lhs new file mode 100644 index 0000000..711050b --- /dev/null +++ b/src/exe/Doc.lhs @@ -0,0 +1,65 @@ +Building documentation +++++++++++++++++++++++ + +.. class:: nodoc + +> {-# LANGUAGE OverloadedStrings #-} +> import Text.Pandoc +> import Text.Pandoc.Highlighting (tango) +> import qualified Data.Text.IO as TIO +> import System.Directory (setCurrentDirectory) +> import Data.Map as M +> import Text.DocTemplates (ToContext(toVal), Context(..)) +> import Data.Text (pack) +> import Data.Either.Combinators (rightToMaybe) + +The documentation can be generated by running ``cabal run pesto-doc``. It is +exclusively based on the restructuredText inside this package’s literal Haskell +source code. + +.. _restructuredText: http://docutils.sourceforge.net/rst.html + +> readDoc = readRST def { +> 	  readerExtensions = extensionsFromList [ +> 		  Ext_literate_haskell +> 		, Ext_implicit_header_references +> 		] +> 	, readerStandalone = True } + + +`Pandoc <http://www.pandoc.org/>`_ outputs a single HTML5 page with syntax +highlighting and MathJax for formulas. + +> writeDoc tpl = writeHtml5String def { +>	  writerTemplate = tpl +> 	, writerHighlightStyle = Just tango +>	, writerNumberSections = True +> 	, writerSectionDivs = True +> 	, writerTabStop = 4 +> 	, writerHTMLMathMethod = MathJax "https://cdn.mathjax.org/mathjax/latest/MathJax.js?config=TeX-AMS-MML_HTMLorMML" +> 	, writerVariables = Context $ M.fromList [ +> 		  ("css", toVal $ pack "pesto.css") +> 		, ("lang", toVal $ pack "en") +> 		, ("include-before", toVal $ pack "<div class=\"wrapper\">") +> 		, ("include-after", toVal $ pack "</div>") +> 		] +> 	} +> +> main = do + +The module ``Codec.Pesto`` serves as starting point and it includes every other +module in a sensible order. For the relative includes to work, we need to +change our current working directory. + +>	tpl <- runIO $ compileDefaultTemplate "html5" +>	setCurrentDirectory "src/lib/Codec" +> 	doc <- TIO.readFile "Pesto.lhs" +> 	result <- runIO $ readDoc doc >>= writeDoc (rightToMaybe tpl) +>	setCurrentDirectory "../../../" +> 	html <- handleError result + +Output is written to the directory ``_build``, which contains the corresponding +stylesheet. + +> 	TIO.writeFile "_build/index.html" html + diff --git a/src/exe/Main.lhs b/src/exe/Main.lhs new file mode 100644 index 0000000..ae663ad --- /dev/null +++ b/src/exe/Main.lhs @@ -0,0 +1,110 @@ +User interface +++++++++++++++ + +.. class:: nodoc + +> module Main (main) where +> import System.Environment (getArgs) +> import Data.List (intercalate) +> +> import Codec.Pesto.Parse (parse, Instruction (Ingredient), Quantity (..)) +> import Codec.Pesto.Graph (extract, toGraph, firstNodeId, resolveReferences, extractIngredients, mergeQuantity) +> import Codec.Pesto.Lint (lint, extractMetadata, Metadata(..), LintResult (LintResult)) +> import Codec.Pesto.Serialize (serialize) + +The user-interface reads a single recipe from the standard input. + +> main = do +> 	(op:_) <- getArgs +> 	s <- getContents +> 	either malformedRecipe (run op) (parse s) + +It has three modes of operation, described in the next sections. + +> run "dot" = runDot +> run "metadata" = runMeta +> run "ingredients" = runIngredients +> run _ = const (putStrLn "unknown operation") + +dot +^^^ + +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 + +> 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) <> "];" + +> 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 ``=``. + +> runMeta stream = maybe (return ()) (mapM_ printMeta) $ uncurry extractMetadata $ streamToGraph stream + +ingredients +^^^^^^^^^^^ + +Extract ingredients and print them in CSV format. This does not take +alternatives into account yet. + +> runIngredients stream = mapM_ (putStrLn . csvQty) $ ingredients +> 	where +> 		(nodes, _) = streamToGraph stream +> 		ingredients = mergeQuantity $ extractIngredients nodes + +> printMeta (_, (key, MetaStr value)) = putStrLn $ key ++ "=" ++ value +> printMeta (_, (key, MetaQty q)) = putStrLn $ key ++ "=" ++ csvQty q + +> csvQty (Quantity a b c) = intercalate "," [serialize a, b, c] + +Appendix +^^^^^^^^ + +> malformedRecipe = print + +> streamToGraph stream = (nodes, edges) +> 	where +> 		doc = (head . extract . snd . unzip) stream +> 		nodes = zip [firstNodeId..] doc +> 		edges = toGraph nodes ++ resolveReferences nodes + diff --git a/src/exe/Test.lhs b/src/exe/Test.lhs new file mode 100644 index 0000000..400192e --- /dev/null +++ b/src/exe/Test.lhs @@ -0,0 +1,22 @@ +Running tests ++++++++++++++ + +.. class:: nodoc + +> import Test.HUnit +> import System.Exit (exitFailure, exitSuccess) +> import Codec.Pesto.Parse (test) +> import Codec.Pesto.Lint (test) +> import Codec.Pesto.Graph (test) + +The testcases can be run with ``cabal test``. This runs *all* testcases from +all modules and prints a summary. + +> main = runTestTT tests >>= \c -> if errors c + failures c > 0 then exitFailure else exitSuccess + +> tests = TestList [ +> 	  "parse" ~: Codec.Pesto.Parse.test +> 	, "graph" ~: Codec.Pesto.Graph.test +> 	, "lint" ~: Codec.Pesto.Lint.test +> 	] + | 
