From dcbffcbcb647fd996862f7b7a422a55501ee74ed Mon Sep 17 00:00:00 2001
From: Hans-Peter Deifel <hpd@hpdeifel.de>
Date: Wed, 29 Aug 2018 11:01:39 +0200
Subject: [PATCH] main: Allow to write graphviz graph to file
... instead of just stdout.
---
src/MA/Dot.hs | 4 ++++
src/main/Main.hs | 17 +++++++++++++++--
2 files changed, 19 insertions(+), 2 deletions(-)
diff --git a/src/MA/Dot.hs b/src/MA/Dot.hs
index 5fbd4a3..60e23d8 100644
--- a/src/MA/Dot.hs
+++ b/src/MA/Dot.hs
@@ -1,5 +1,6 @@
module MA.Dot
( printDot
+ , writeDot
) where
import Data.Semigroup
@@ -23,6 +24,9 @@ import MA.PrettyShow
printDot :: (PrettyShow label, PrettyShow h1) => SymbolTable -> Encoding label (Sorted h1) -> IO ()
printDot symbolTable = LazyIO.putStr . Build.toLazyText . dot symbolTable
+writeDot :: (PrettyShow label, PrettyShow h1) => FilePath -> SymbolTable -> Encoding label (Sorted h1) -> IO ()
+writeDot file symbolTable = LazyIO.writeFile file . Build.toLazyText . dot symbolTable
+
dot :: (PrettyShow label, PrettyShow h1) => SymbolTable -> Encoding label (Sorted h1) -> Builder
dot symbolTable encoding =
"digraph {\n" <> nodes symbolTable (Encoding.structure encoding) <>
diff --git a/src/main/Main.hs b/src/main/Main.hs
index ec27346..aae63a7 100644
--- a/src/main/Main.hs
+++ b/src/main/Main.hs
@@ -115,6 +115,7 @@ refineOptions = do
data DotOptions = DotOptions
{ dotInputFile :: Maybe FilePath
+ , dotOutputFile :: Maybe FilePath
}
dotOptions :: Parser DotOptions
@@ -129,7 +130,16 @@ dotOptions = do
\See the \"help\" command for a description of available syntax." <>
value "-" <>
showDefault))
- pure DotOptions{..}
+ dotOutputFile <-
+ optional
+ (argument
+ str
+ (metavar "OUTPUT_FILE" <>
+ help
+ "Name of the file to print the output to or \"-\" for standard output." <>
+ value "-" <>
+ showDefault))
+ pure DotOptions {..}
functorReader :: ReadM (FunctorExpression SomeFunctor Sort)
functorReader = eitherReader (\input -> parseFunctor input (T.pack input))
@@ -263,7 +273,10 @@ main = do
Left err -> hPutStrLn stderr err >> exitFailure
Right res -> evaluate $ res
- printDot symbolTable encoding
+ case dotOutputFile r of
+ Nothing -> printDot symbolTable encoding
+ Just "-" -> printDot symbolTable encoding
+ Just file -> writeDot file symbolTable encoding
printHelp :: HelpCommand -> IO ()
printHelp HelpListFunctors =
--
GitLab