summaryrefslogtreecommitdiff
path: root/src/exe
diff options
context:
space:
mode:
authorLars-Dominik Braun <lars@6xq.net>2020-08-24 17:09:34 +0200
committerLars-Dominik Braun <lars@6xq.net>2020-08-24 17:09:34 +0200
commit295dd897297722d07ec2ce5fb82e323fe495c775 (patch)
tree8d9de652a030c34c6be775ca31c159620f52fbf1 /src/exe
parent39f9263fa38c32ce2e3a4f4bedb8349da47a3200 (diff)
downloadpesto-295dd897297722d07ec2ce5fb82e323fe495c775.tar.gz
pesto-295dd897297722d07ec2ce5fb82e323fe495c775.tar.bz2
pesto-295dd897297722d07ec2ce5fb82e323fe495c775.zip
GHC 8.8, cabal 3, pandoc 2.10 compatibility
Move files around to separate Pesto (the library) and Pesto (the executables). Fixes for pandoc API changes.
Diffstat (limited to 'src/exe')
-rw-r--r--src/exe/Doc.lhs66
-rw-r--r--src/exe/Main.lhs106
-rw-r--r--src/exe/Test.lhs22
3 files changed, 194 insertions, 0 deletions
diff --git a/src/exe/Doc.lhs b/src/exe/Doc.lhs
new file mode 100644
index 0000000..63e9847
--- /dev/null
+++ b/src/exe/Doc.lhs
@@ -0,0 +1,66 @@
+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 running ``cabal run pesto-doc``. It is
+exclusively based on the restructuredText inside this packages’ 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/
+
+Pandoc_ 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..2f67ffd
--- /dev/null
+++ b/src/exe/Main.lhs
@@ -0,0 +1,106 @@
+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)
+> import Codec.Pesto.Lint (lint, extractMetadata, Metadata(..), LintResult (LintResult))
+> import Codec.Pesto.Serialize (serialize)
+
+The user-interface has different modes of operation. All of them read a single
+recipe from the standard input.
+
+> main = do
+> (op:_) <- getArgs
+> 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)
+> where
+> doc = (head . extract . snd . unzip) stream
+> nodes = zip [firstNodeId..] doc
+> edges = toGraph nodes ++ resolveReferences nodes
+
+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) $ reverse $ foldl getIngredient [] stream
+> where
+> getIngredient xs (_, Ingredient q) = q:xs
+> getIngredient xs _ = xs
+
+> 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]
+
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
+> ]
+