From 295dd897297722d07ec2ce5fb82e323fe495c775 Mon Sep 17 00:00:00 2001 From: Lars-Dominik Braun Date: Mon, 24 Aug 2020 17:09:34 +0200 Subject: 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. --- src/exe/Doc.lhs | 66 ++++++++++++++++++++++++++++++++++ src/exe/Main.lhs | 106 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ src/exe/Test.lhs | 22 ++++++++++++ 3 files changed, 194 insertions(+) create mode 100644 src/exe/Doc.lhs create mode 100644 src/exe/Main.lhs create mode 100644 src/exe/Test.lhs (limited to 'src/exe') 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 "
") +> , ("include-after", toVal $ pack "
") +> ] +> } +> +> 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 +> ] + -- cgit v1.2.3