{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Calligraphy (main, mainWithConfig) where

import Calligraphy.Compat.Debug (ppHieFile)
import qualified Calligraphy.Compat.GHC as GHC
import Calligraphy.Phases.DependencyFilter
import Calligraphy.Phases.EdgeCleanup
import Calligraphy.Phases.NodeFilter
import Calligraphy.Phases.Parse
import Calligraphy.Phases.Render
import Calligraphy.Phases.Search
import Calligraphy.Util.Printer
import Calligraphy.Util.Types (ppCallGraph)
import Control.Monad.RWS
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as Text
import Data.Version (showVersion)
import Options.Applicative
import Paths_calligraphy (version)
import System.Directory (findExecutable)
import System.Exit
import System.IO (stderr)
import System.Process

main :: IO ()
main :: IO ()
main = do
  AppConfig
config <- ParserInfo AppConfig -> IO AppConfig
forall a. ParserInfo a -> IO a
execParser (ParserInfo AppConfig -> IO AppConfig)
-> ParserInfo AppConfig -> IO AppConfig
forall a b. (a -> b) -> a -> b
$ Parser AppConfig -> InfoMod AppConfig -> ParserInfo AppConfig
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser AppConfig
pConfig Parser AppConfig
-> Parser (AppConfig -> AppConfig) -> Parser AppConfig
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (AppConfig -> AppConfig)
forall a. Parser (a -> a)
helper Parser AppConfig
-> Parser (AppConfig -> AppConfig) -> Parser AppConfig
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (AppConfig -> AppConfig)
forall a. Parser (a -> a)
versionP) InfoMod AppConfig
forall a. Monoid a => a
mempty
  AppConfig -> IO ()
mainWithConfig AppConfig
config
  where
    versionP :: Parser (a -> a)
versionP =
      String -> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a. String -> Mod OptionFields (a -> a) -> Parser (a -> a)
infoOption
        ( String
"calligraphy version "
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Version -> String
showVersion Version
version
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\nhie version "
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Integer -> String
forall a. Show a => a -> String
show Integer
GHC.hieVersion
        )
        (String -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"version" Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. String -> Mod f a
help String
"Show version")

mainWithConfig :: AppConfig -> IO ()
mainWithConfig :: AppConfig -> IO ()
mainWithConfig AppConfig {SearchConfig
RenderConfig
NodeFilterConfig
EdgeCleanupConfig
DependencyFilterConfig
DebugConfig
OutputConfig
debugConfig :: AppConfig -> DebugConfig
outputConfig :: AppConfig -> OutputConfig
renderConfig :: AppConfig -> RenderConfig
edgeFilterConfig :: AppConfig -> EdgeCleanupConfig
dependencyFilterConfig :: AppConfig -> DependencyFilterConfig
nodeFilterConfig :: AppConfig -> NodeFilterConfig
searchConfig :: AppConfig -> SearchConfig
debugConfig :: DebugConfig
outputConfig :: OutputConfig
renderConfig :: RenderConfig
edgeFilterConfig :: EdgeCleanupConfig
dependencyFilterConfig :: DependencyFilterConfig
nodeFilterConfig :: NodeFilterConfig
searchConfig :: SearchConfig
..} = do
  let debug :: (DebugConfig -> Bool) -> Printer () -> IO ()
      debug :: (DebugConfig -> Bool) -> Printer () -> IO ()
debug DebugConfig -> Bool
fp Printer ()
printer = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DebugConfig -> Bool
fp DebugConfig
debugConfig) (Printer () -> IO ()
printStderr Printer ()
printer)

  [HieFile]
hieFiles <- SearchConfig -> IO [HieFile]
searchFiles SearchConfig
searchConfig
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([HieFile] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HieFile]
hieFiles) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
forall a. String -> IO a
die String
"No files matched your search criteria.."
  (DebugConfig -> Bool) -> Printer () -> IO ()
debug DebugConfig -> Bool
dumpHieFile (Printer () -> IO ()) -> Printer () -> IO ()
forall a b. (a -> b) -> a -> b
$ (HieFile -> Printer ()) -> [HieFile] -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ HieFile -> Printer ()
ppHieFile [HieFile]
hieFiles

  (ParsePhaseDebugInfo
parsePhaseDebug, CallGraph
cgParsed) <- (ParseError -> IO (ParsePhaseDebugInfo, CallGraph))
-> ((ParsePhaseDebugInfo, CallGraph)
    -> IO (ParsePhaseDebugInfo, CallGraph))
-> Either ParseError (ParsePhaseDebugInfo, CallGraph)
-> IO (ParsePhaseDebugInfo, CallGraph)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Printer () -> IO (ParsePhaseDebugInfo, CallGraph)
forall a. Printer () -> IO a
printDie (Printer () -> IO (ParsePhaseDebugInfo, CallGraph))
-> (ParseError -> Printer ())
-> ParseError
-> IO (ParsePhaseDebugInfo, CallGraph)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> Printer ()
ppParseError) (ParsePhaseDebugInfo, CallGraph)
-> IO (ParsePhaseDebugInfo, CallGraph)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([HieFile] -> Either ParseError (ParsePhaseDebugInfo, CallGraph)
parseHieFiles [HieFile]
hieFiles)
  (DebugConfig -> Bool) -> Printer () -> IO ()
debug DebugConfig -> Bool
dumpLexicalTree (Printer () -> IO ()) -> Printer () -> IO ()
forall a b. (a -> b) -> a -> b
$ Prints ParsePhaseDebugInfo
ppParsePhaseDebugInfo ParsePhaseDebugInfo
parsePhaseDebug
  let cgCollapsed :: CallGraph
cgCollapsed = NodeFilterConfig -> CallGraph -> CallGraph
filterNodes NodeFilterConfig
nodeFilterConfig CallGraph
cgParsed
  CallGraph
cgDependencyFiltered <- (DependencyFilterError -> IO CallGraph)
-> (CallGraph -> IO CallGraph)
-> Either DependencyFilterError CallGraph
-> IO CallGraph
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Printer () -> IO CallGraph
forall a. Printer () -> IO a
printDie (Printer () -> IO CallGraph)
-> (DependencyFilterError -> Printer ())
-> DependencyFilterError
-> IO CallGraph
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DependencyFilterError -> Printer ()
ppFilterError) CallGraph -> IO CallGraph
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either DependencyFilterError CallGraph -> IO CallGraph)
-> Either DependencyFilterError CallGraph -> IO CallGraph
forall a b. (a -> b) -> a -> b
$ DependencyFilterConfig
-> CallGraph -> Either DependencyFilterError CallGraph
dependencyFilter DependencyFilterConfig
dependencyFilterConfig CallGraph
cgCollapsed
  let cgCleaned :: CallGraph
cgCleaned = EdgeCleanupConfig -> CallGraph -> CallGraph
cleanupEdges EdgeCleanupConfig
edgeFilterConfig CallGraph
cgDependencyFiltered
  (DebugConfig -> Bool) -> Printer () -> IO ()
debug DebugConfig -> Bool
dumpFinal (Printer () -> IO ()) -> Printer () -> IO ()
forall a b. (a -> b) -> a -> b
$ Prints CallGraph
ppCallGraph CallGraph
cgCleaned

  let renderConfig' :: RenderConfig
renderConfig' = RenderConfig
renderConfig {clusterModules :: Bool
clusterModules = RenderConfig -> Bool
clusterModules RenderConfig
renderConfig Bool -> Bool -> Bool
&& Bool -> Bool
not (NodeFilterConfig -> Bool
collapseModules NodeFilterConfig
nodeFilterConfig)}
      txt :: Text
txt = Printer () -> Text
runPrinter (Printer () -> Text) -> Printer () -> Text
forall a b. (a -> b) -> a -> b
$ RenderConfig -> Prints CallGraph
render RenderConfig
renderConfig' CallGraph
cgCleaned

  OutputConfig -> Text -> IO ()
output OutputConfig
outputConfig Text
txt

data AppConfig = AppConfig
  { AppConfig -> SearchConfig
searchConfig :: SearchConfig,
    AppConfig -> NodeFilterConfig
nodeFilterConfig :: NodeFilterConfig,
    AppConfig -> DependencyFilterConfig
dependencyFilterConfig :: DependencyFilterConfig,
    AppConfig -> EdgeCleanupConfig
edgeFilterConfig :: EdgeCleanupConfig,
    AppConfig -> RenderConfig
renderConfig :: RenderConfig,
    AppConfig -> OutputConfig
outputConfig :: OutputConfig,
    AppConfig -> DebugConfig
debugConfig :: DebugConfig
  }

printStderr :: Printer () -> IO ()
printStderr :: Printer () -> IO ()
printStderr = Handle -> Text -> IO ()
Text.hPutStrLn Handle
stderr (Text -> IO ()) -> (Printer () -> Text) -> Printer () -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Printer () -> Text
runPrinter

printDie :: Printer () -> IO a
printDie :: Printer () -> IO a
printDie Printer ()
txt = Printer () -> IO ()
printStderr Printer ()
txt IO () -> IO a -> IO a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO a
forall a. IO a
exitFailure

pConfig :: Parser AppConfig
pConfig :: Parser AppConfig
pConfig =
  SearchConfig
-> NodeFilterConfig
-> DependencyFilterConfig
-> EdgeCleanupConfig
-> RenderConfig
-> OutputConfig
-> DebugConfig
-> AppConfig
AppConfig (SearchConfig
 -> NodeFilterConfig
 -> DependencyFilterConfig
 -> EdgeCleanupConfig
 -> RenderConfig
 -> OutputConfig
 -> DebugConfig
 -> AppConfig)
-> Parser SearchConfig
-> Parser
     (NodeFilterConfig
      -> DependencyFilterConfig
      -> EdgeCleanupConfig
      -> RenderConfig
      -> OutputConfig
      -> DebugConfig
      -> AppConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SearchConfig
pSearchConfig
    Parser
  (NodeFilterConfig
   -> DependencyFilterConfig
   -> EdgeCleanupConfig
   -> RenderConfig
   -> OutputConfig
   -> DebugConfig
   -> AppConfig)
-> Parser NodeFilterConfig
-> Parser
     (DependencyFilterConfig
      -> EdgeCleanupConfig
      -> RenderConfig
      -> OutputConfig
      -> DebugConfig
      -> AppConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser NodeFilterConfig
pNodeFilterConfig
    Parser
  (DependencyFilterConfig
   -> EdgeCleanupConfig
   -> RenderConfig
   -> OutputConfig
   -> DebugConfig
   -> AppConfig)
-> Parser DependencyFilterConfig
-> Parser
     (EdgeCleanupConfig
      -> RenderConfig -> OutputConfig -> DebugConfig -> AppConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser DependencyFilterConfig
pDependencyFilterConfig
    Parser
  (EdgeCleanupConfig
   -> RenderConfig -> OutputConfig -> DebugConfig -> AppConfig)
-> Parser EdgeCleanupConfig
-> Parser
     (RenderConfig -> OutputConfig -> DebugConfig -> AppConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser EdgeCleanupConfig
pEdgeCleanupConfig
    Parser (RenderConfig -> OutputConfig -> DebugConfig -> AppConfig)
-> Parser RenderConfig
-> Parser (OutputConfig -> DebugConfig -> AppConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser RenderConfig
pRenderConfig
    Parser (OutputConfig -> DebugConfig -> AppConfig)
-> Parser OutputConfig -> Parser (DebugConfig -> AppConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser OutputConfig
pOutputConfig
    Parser (DebugConfig -> AppConfig)
-> Parser DebugConfig -> Parser AppConfig
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser DebugConfig
pDebugConfig

output :: OutputConfig -> Text -> IO ()
output :: OutputConfig -> Text -> IO ()
output cfg :: OutputConfig
cfg@OutputConfig {Bool
String
Maybe String
outputStdout :: OutputConfig -> Bool
outputEngine :: OutputConfig -> String
outputSvgPath :: OutputConfig -> Maybe String
outputPngPath :: OutputConfig -> Maybe String
outputDotPath :: OutputConfig -> Maybe String
outputStdout :: Bool
outputEngine :: String
outputSvgPath :: Maybe String
outputPngPath :: Maybe String
outputDotPath :: Maybe String
..} Text
txt = do
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (OutputConfig -> Bool
hasOutput OutputConfig
cfg) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> Text -> IO ()
Text.hPutStrLn Handle
stderr Text
"Warning: no output options specified, run with --help to see options"
  Maybe String -> (String -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe String
outputDotPath ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \String
fp -> String -> Text -> IO ()
Text.writeFile String
fp Text
txt
  Maybe String -> (String -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe String
outputPngPath ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \String
fp -> [String] -> IO ()
runDot [String
"-Tpng", String
"-o", String
fp]
  Maybe String -> (String -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe String
outputSvgPath ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \String
fp -> [String] -> IO ()
runDot [String
"-Tsvg", String
"-o", String
fp]
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
outputStdout (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
Text.putStrLn Text
txt
  where
    hasOutput :: OutputConfig -> Bool
hasOutput (OutputConfig Maybe String
Nothing Maybe String
Nothing Maybe String
Nothing String
_ Bool
False) = Bool
False
    hasOutput OutputConfig
_ = Bool
True

    runDot :: [String] -> IO ()
runDot [String]
flags = do
      Maybe String
mexe <- String -> IO (Maybe String)
findExecutable String
outputEngine
      case Maybe String
mexe of
        Maybe String
Nothing -> String -> IO ()
forall a. String -> IO a
die (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Unable to find '" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
outputEngine String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"' executable! Make sure it is installed, or use another output method/engine."
        Just String
exe -> do
          (ExitCode
code, String
out, String
err) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode String
exe [String]
flags (Text -> String
T.unpack Text
txt)
          Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
outputEngine String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" crashed:"
            String -> IO ()
putStrLn String
out
            String -> IO ()
putStrLn String
err

data OutputConfig = OutputConfig
  { OutputConfig -> Maybe String
outputDotPath :: Maybe FilePath,
    OutputConfig -> Maybe String
outputPngPath :: Maybe FilePath,
    OutputConfig -> Maybe String
outputSvgPath :: Maybe FilePath,
    OutputConfig -> String
outputEngine :: String,
    OutputConfig -> Bool
outputStdout :: Bool
  }

pOutputConfig :: Parser OutputConfig
pOutputConfig :: Parser OutputConfig
pOutputConfig =
  Maybe String
-> Maybe String -> Maybe String -> String -> Bool -> OutputConfig
OutputConfig
    (Maybe String
 -> Maybe String -> Maybe String -> String -> Bool -> OutputConfig)
-> Parser (Maybe String)
-> Parser
     (Maybe String -> Maybe String -> String -> Bool -> OutputConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"output-dot" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'd' Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"FILE" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
".dot output path"))
    Parser
  (Maybe String -> Maybe String -> String -> Bool -> OutputConfig)
-> Parser (Maybe String)
-> Parser (Maybe String -> String -> Bool -> OutputConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"output-png" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'p' Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"FILE" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
".png output path (requires `dot` or other engine in PATH)"))
    Parser (Maybe String -> String -> Bool -> OutputConfig)
-> Parser (Maybe String) -> Parser (String -> Bool -> OutputConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"output-svg" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
's' Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"FILE" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
".svg output path (requires `dot` or other engine in PATH)"))
    Parser (String -> Bool -> OutputConfig)
-> Parser String -> Parser (Bool -> OutputConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"render-engine" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"CMD" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"Render engine to use with --output-png and --output-svg" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value String
"dot" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields String
forall a (f :: * -> *). Show a => Mod f a
showDefault)
    Parser (Bool -> OutputConfig) -> Parser Bool -> Parser OutputConfig
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"output-stdout" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Output to stdout")

data DebugConfig = DebugConfig
  { DebugConfig -> Bool
dumpHieFile :: Bool,
    DebugConfig -> Bool
dumpLexicalTree :: Bool,
    DebugConfig -> Bool
dumpFinal :: Bool
  }

pDebugConfig :: Parser DebugConfig
pDebugConfig :: Parser DebugConfig
pDebugConfig =
  Bool -> Bool -> Bool -> DebugConfig
DebugConfig
    (Bool -> Bool -> Bool -> DebugConfig)
-> Parser Bool -> Parser (Bool -> Bool -> DebugConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"ddump-hie-file" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Debug dump raw HIE files.")
    Parser (Bool -> Bool -> DebugConfig)
-> Parser Bool -> Parser (Bool -> DebugConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"ddump-lexical-tree" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Debug dump the reconstructed lexical structure of HIE files, the intermediate output in the parsing phase.")
    Parser (Bool -> DebugConfig) -> Parser Bool -> Parser DebugConfig
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"ddump-final" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Debug dump the final tree after processing, i.e. as it will be rendered.")