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

-- | Rendering takes a callgraph, and produces a dot file
module Calligraphy.Phases.Render (render, pRenderConfig, RenderConfig (..)) where

import Calligraphy.Util.Printer
import Calligraphy.Util.Types
import Control.Monad
import qualified Data.EnumSet as EnumSet
import Data.List (intercalate)
import Data.Tree (Tree (..))
import Options.Applicative hiding (style)
import Text.Show (showListWith)

data RenderConfig = RenderConfig
  { RenderConfig -> Bool
showCalls :: Bool,
    RenderConfig -> Bool
showTypes :: Bool,
    RenderConfig -> Bool
showKey :: Bool,
    RenderConfig -> Bool
showGHCKeys :: Bool,
    RenderConfig -> Bool
showModulePath :: Bool,
    RenderConfig -> Bool
showChildArrowhead :: Bool,
    RenderConfig -> LocMode
locMode :: LocMode,
    RenderConfig -> Bool
clusterModules :: Bool,
    RenderConfig -> Bool
clusterGroups :: Bool,
    RenderConfig -> Bool
splines :: Bool,
    RenderConfig -> Bool
reverseDependencyRank :: Bool
  }

render :: RenderConfig -> Prints CallGraph
render :: RenderConfig -> Prints CallGraph
render RenderConfig {Bool
LocMode
reverseDependencyRank :: Bool
splines :: Bool
clusterGroups :: Bool
clusterModules :: Bool
locMode :: LocMode
showChildArrowhead :: Bool
showModulePath :: Bool
showGHCKeys :: Bool
showKey :: Bool
showTypes :: Bool
showCalls :: Bool
reverseDependencyRank :: RenderConfig -> Bool
splines :: RenderConfig -> Bool
clusterGroups :: RenderConfig -> Bool
clusterModules :: RenderConfig -> Bool
locMode :: RenderConfig -> LocMode
showChildArrowhead :: RenderConfig -> Bool
showModulePath :: RenderConfig -> Bool
showGHCKeys :: RenderConfig -> Bool
showKey :: RenderConfig -> Bool
showTypes :: RenderConfig -> Bool
showCalls :: RenderConfig -> Bool
..} (CallGraph [Module]
modules Set (Key, Key)
calls Set (Key, Key)
types) = do
  String -> String -> Printer () -> Printer ()
forall (m :: * -> *) a.
MonadPrint m =>
String -> String -> m a -> m a
brack String
"digraph calligraphy {" String
"}" (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
    Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
splines (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Text -> Printer ()
forall (m :: * -> *). MonadPrint m => Text -> m ()
textLn Text
"splines=false;"
    Text -> Printer ()
forall (m :: * -> *). MonadPrint m => Text -> m ()
textLn Text
"node [style=filled fillcolor=\"#ffffffcf\"];"
    Text -> Printer ()
forall (m :: * -> *). MonadPrint m => Text -> m ()
textLn Text
"graph [outputorder=edgesfirst];"
    let nonEmptyModules :: [Module]
nonEmptyModules = (Module -> Bool) -> [Module] -> [Module]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Module -> Bool) -> Module -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tree Decl] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Tree Decl] -> Bool) -> (Module -> [Tree Decl]) -> Module -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> [Tree Decl]
moduleForest) [Module]
modules
    [(Module, Int)] -> ((Module, Int) -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Module] -> [Int] -> [(Module, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Module]
nonEmptyModules [Int
0 :: Int ..]) (((Module, Int) -> Printer ()) -> Printer ())
-> ((Module, Int) -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$
      \(Module String
modName String
modPath [Tree Decl]
forest, Int
moduleIx) ->
        Int -> String -> Printer () -> Printer ()
forall a. Int -> String -> Printer a -> Printer a
moduleCluster Int
moduleIx (if Bool
showModulePath then String
modPath else String
modName) (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$
          [(Tree Decl, Int)]
-> ((Tree Decl, Int) -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Tree Decl] -> [Int] -> [(Tree Decl, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Tree Decl]
forest [Int
0 :: Int ..]) (((Tree Decl, Int) -> Printer ()) -> Printer ())
-> ((Tree Decl, Int) -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \(Tree Decl
root, Int
forestIx) -> do
            Int -> Int -> Printer () -> Printer ()
forall a. Int -> Int -> Printer a -> Printer a
treeCluster Int
moduleIx Int
forestIx (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$
              Prints (Tree Decl)
renderTreeNode Tree Decl
root
    Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
showCalls (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$
      Set (Key, Key) -> ((Key, Key) -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Set (Key, Key)
calls (((Key, Key) -> Printer ()) -> Printer ())
-> ((Key, Key) -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \(Key
caller, Key
callee) ->
        if Bool
reverseDependencyRank
          then Key -> Key -> Style -> Printer ()
forall (m :: * -> *). MonadPrint m => Key -> Key -> Style -> m ()
edge Key
caller Key
callee []
          else Key -> Key -> Style -> Printer ()
forall (m :: * -> *). MonadPrint m => Key -> Key -> Style -> m ()
edge Key
callee Key
caller [String
"dir" String -> String -> (String, String)
.= String
"back"]
    Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
showTypes (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$
      Set (Key, Key) -> ((Key, Key) -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Set (Key, Key)
types (((Key, Key) -> Printer ()) -> Printer ())
-> ((Key, Key) -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \(Key
caller, Key
callee) ->
        if Bool
reverseDependencyRank
          then Key -> Key -> Style -> Printer ()
forall (m :: * -> *). MonadPrint m => Key -> Key -> Style -> m ()
edge Key
caller Key
callee [String
"style" String -> String -> (String, String)
.= String
"dotted"]
          else Key -> Key -> Style -> Printer ()
forall (m :: * -> *). MonadPrint m => Key -> Key -> Style -> m ()
edge Key
callee Key
caller [String
"style" String -> String -> (String, String)
.= String
"dotted", String
"dir" String -> String -> (String, String)
.= String
"back"]
  where
    moduleCluster :: Int -> String -> Printer a -> Printer a
    moduleCluster :: Int -> String -> Printer a -> Printer a
moduleCluster Int
modIx String
title Printer a
inner
      | Bool
clusterModules =
          String -> String -> Printer a -> Printer a
forall (m :: * -> *) a.
MonadPrint m =>
String -> String -> m a -> m a
brack (String
"subgraph cluster_module_" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
modIx String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" {") String
"}" (Printer a -> Printer a) -> Printer a -> Printer a
forall a b. (a -> b) -> a -> b
$ do
            String -> Printer ()
forall (m :: * -> *). MonadPrint m => String -> m ()
strLn (String -> Printer ()) -> String -> Printer ()
forall a b. (a -> b) -> a -> b
$ String
"label=" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
forall a. Show a => a -> String
show String
title String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
";"
            Printer a
inner
      | Bool
otherwise = Printer a
inner
    treeCluster :: Int -> Int -> Printer a -> Printer a
    treeCluster :: Int -> Int -> Printer a -> Printer a
treeCluster Int
modIx Int
groupIx Printer a
inner
      | Bool
clusterGroups =
          String -> String -> Printer a -> Printer a
forall (m :: * -> *) a.
MonadPrint m =>
String -> String -> m a -> m a
brack (String
"subgraph cluster_" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
modIx String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
groupIx String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" {") String
"}" (Printer a -> Printer a) -> Printer a -> Printer a
forall a b. (a -> b) -> a -> b
$ do
            Text -> Printer ()
forall (m :: * -> *). MonadPrint m => Text -> m ()
textLn Text
"style=invis;"
            Printer a
inner
      | Bool
otherwise = Printer a
inner
    nodeLabel :: Decl -> String
    nodeLabel :: Decl -> String
nodeLabel (Decl String
name Key
key EnumSet GHCKey
ghcKeys Bool
_ DeclType
_ Loc
loc) =
      String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n"
        ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> [String]
forall a. a -> [a] -> [a]
cons String
name
        ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> String -> [String] -> [String]
forall a. Bool -> a -> [a] -> [a]
consIf Bool
showKey (Int -> String
forall a. Show a => a -> String
show (Key -> Int
unKey Key
key))
        ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> [String] -> [String] -> [String]
forall (f :: * -> *) a. Foldable f => Bool -> f a -> [a] -> [a]
consManyIf Bool
showGHCKeys ((GHCKey -> String) -> [GHCKey] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> (GHCKey -> Int) -> GHCKey -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GHCKey -> Int
unGHCKey) (EnumSet GHCKey -> [GHCKey]
forall k. Enum k => EnumSet k -> [k]
EnumSet.toList EnumSet GHCKey
ghcKeys))
        ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ( case LocMode
locMode of
              LocMode
Hide -> [String] -> [String]
forall a. a -> a
id
              LocMode
Line -> String -> [String] -> [String]
forall a. a -> [a] -> [a]
cons (Char
'L' Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> String
forall a. Show a => a -> String
show (Loc -> Int
locLine Loc
loc))
              LocMode
LineCol -> String -> [String] -> [String]
forall a. a -> [a] -> [a]
cons (Loc -> String
forall a. Show a => a -> String
show Loc
loc)
          )
        ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ []

    renderTreeNode :: Prints (Tree Decl)
    renderTreeNode :: Prints (Tree Decl)
renderTreeNode (Node decl :: Decl
decl@(Decl String
_ Key
key EnumSet GHCKey
_ Bool
exported DeclType
typ Loc
_) [Tree Decl]
children) = do
      String -> Printer ()
forall (m :: * -> *). MonadPrint m => String -> m ()
strLn (String -> Printer ()) -> String -> Printer ()
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show (Key -> Int
unKey Key
key) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Style -> String
style [String
"label" String -> String -> (String, String)
.= (String
"\"" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Decl -> String
nodeLabel Decl
decl String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\""), String
"shape" String -> String -> (String, String)
.= DeclType -> String
nodeShape DeclType
typ, String
"style" String -> String -> (String, String)
.= String
nodeStyle]
      [Tree Decl] -> Prints (Tree Decl) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Tree Decl]
children (Prints (Tree Decl) -> Printer ())
-> Prints (Tree Decl) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \child :: Tree Decl
child@(Node Decl
childDecl [Tree Decl]
_) -> do
        Prints (Tree Decl)
renderTreeNode Tree Decl
child
        Key -> Key -> Style -> Printer ()
forall (m :: * -> *). MonadPrint m => Key -> Key -> Style -> m ()
edge Key
key (Decl -> Key
declKey Decl
childDecl)
          (Style -> Printer ()) -> (Style -> Style) -> Style -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> Style -> Style
forall a. a -> [a] -> [a]
cons (String
"style" String -> String -> (String, String)
.= String
"dashed")
          (Style -> Style) -> (Style -> Style) -> Style -> Style
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> (String, String) -> Style -> Style
forall a. Bool -> a -> [a] -> [a]
consIf (Bool -> Bool
not Bool
showChildArrowhead) (String
"arrowhead" String -> String -> (String, String)
.= String
"none")
          (Style -> Printer ()) -> Style -> Printer ()
forall a b. (a -> b) -> a -> b
$ []
      where
        nodeStyle :: String
        nodeStyle :: String
nodeStyle =
          String -> String
forall a. Show a => a -> String
show (String -> String) -> ([String] -> String) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", "
            ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> String -> [String] -> [String]
forall a. Bool -> a -> [a] -> [a]
consIf (DeclType
typ DeclType -> DeclType -> Bool
forall a. Eq a => a -> a -> Bool
== DeclType
RecDecl) String
"rounded"
            ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> String -> [String] -> [String]
forall a. Bool -> a -> [a] -> [a]
consIf (Bool -> Bool
not Bool
exported) String
"dashed"
            ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> [String]
forall a. a -> [a] -> [a]
cons String
"filled"
            ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ []

cons :: a -> [a] -> [a]
cons :: a -> [a] -> [a]
cons = (:)

consIf :: Bool -> a -> [a] -> [a]
consIf :: Bool -> a -> [a] -> [a]
consIf Bool
True = (:)
consIf Bool
False = ([a] -> a -> [a]) -> a -> [a] -> [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip [a] -> a -> [a]
forall a b. a -> b -> a
const

consManyIf :: Foldable f => Bool -> f a -> [a] -> [a]
consManyIf :: Bool -> f a -> [a] -> [a]
consManyIf Bool
True f a
fs [a]
as = (a -> [a] -> [a]) -> [a] -> f a -> [a]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (:) [a]
as f a
fs
consManyIf Bool
False f a
_ [a]
as = [a]
as

nodeShape :: DeclType -> String
nodeShape :: DeclType -> String
nodeShape DeclType
DataDecl = String
"octagon"
nodeShape DeclType
ConDecl = String
"box"
nodeShape DeclType
RecDecl = String
"box"
nodeShape DeclType
ClassDecl = String
"house"
nodeShape DeclType
ValueDecl = String
"ellipse"

edge :: MonadPrint m => Key -> Key -> Style -> m ()
edge :: Key -> Key -> Style -> m ()
edge (Key Int
from) (Key Int
to) Style
sty = String -> m ()
forall (m :: * -> *). MonadPrint m => String -> m ()
strLn (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
from String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" -> " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
to String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Style -> String
style Style
sty

(.=) :: String -> String -> (String, String)
.= :: String -> String -> (String, String)
(.=) = (,)

style :: Style -> String
style :: Style -> String
style Style
sty = ((String, String) -> String -> String) -> Style -> String -> String
forall a. (a -> String -> String) -> [a] -> String -> String
showListWith (\(String
key, String
val) -> String -> String -> String
showString String
key (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String -> String
showChar Char
'=' (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
showString String
val) Style
sty String
";"

type Style = [(String, String)]

data LocMode = Hide | Line | LineCol

pLocMode :: Parser LocMode
pLocMode :: Parser LocMode
pLocMode =
  LocMode -> Mod FlagFields LocMode -> Parser LocMode
forall a. a -> Mod FlagFields a -> Parser a
flag' LocMode
Line (String -> Mod FlagFields LocMode
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"show-line" Mod FlagFields LocMode
-> Mod FlagFields LocMode -> Mod FlagFields LocMode
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields LocMode
forall (f :: * -> *) a. String -> Mod f a
help String
"Show line numbers")
    Parser LocMode -> Parser LocMode -> Parser LocMode
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LocMode -> Mod FlagFields LocMode -> Parser LocMode
forall a. a -> Mod FlagFields a -> Parser a
flag' LocMode
LineCol (String -> Mod FlagFields LocMode
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"show-line-col" Mod FlagFields LocMode
-> Mod FlagFields LocMode -> Mod FlagFields LocMode
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields LocMode
forall (f :: * -> *) a. String -> Mod f a
help String
"Show line and column numbers")
    Parser LocMode -> Parser LocMode -> Parser LocMode
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LocMode -> Parser LocMode
forall (f :: * -> *) a. Applicative f => a -> f a
pure LocMode
Hide

pRenderConfig :: Parser RenderConfig
pRenderConfig :: Parser RenderConfig
pRenderConfig =
  Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> LocMode
-> Bool
-> Bool
-> Bool
-> Bool
-> RenderConfig
RenderConfig
    (Bool
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> LocMode
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> RenderConfig)
-> Parser Bool
-> Parser
     (Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> LocMode
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> RenderConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Bool -> Mod FlagFields Bool -> Parser Bool
forall a. a -> a -> Mod FlagFields a -> Parser a
flag Bool
True Bool
False (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"hide-calls" 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
"Don't show call arrows")
    Parser
  (Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> LocMode
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> RenderConfig)
-> Parser Bool
-> Parser
     (Bool
      -> Bool
      -> Bool
      -> Bool
      -> LocMode
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> RenderConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> Bool -> Mod FlagFields Bool -> Parser Bool
forall a. a -> a -> Mod FlagFields a -> Parser a
flag Bool
True Bool
False (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"hide-types" 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
"Don't show type arrows")
    Parser
  (Bool
   -> Bool
   -> Bool
   -> Bool
   -> LocMode
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> RenderConfig)
-> Parser Bool
-> Parser
     (Bool
      -> Bool
      -> Bool
      -> LocMode
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> RenderConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> Bool -> Mod FlagFields Bool -> Parser Bool
forall a. a -> a -> Mod FlagFields a -> Parser a
flag Bool
False Bool
True (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"show-key" 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
"Show internal keys with identifiers. Useful for debugging.")
    Parser
  (Bool
   -> Bool
   -> Bool
   -> LocMode
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> RenderConfig)
-> Parser Bool
-> Parser
     (Bool
      -> Bool -> LocMode -> Bool -> Bool -> Bool -> Bool -> RenderConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> Bool -> Mod FlagFields Bool -> Parser Bool
forall a. a -> a -> Mod FlagFields a -> Parser a
flag Bool
False Bool
True (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"show-ghc-key" 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
"Show GHC keys with identifiers. Useful for debugging.")
    Parser
  (Bool
   -> Bool -> LocMode -> Bool -> Bool -> Bool -> Bool -> RenderConfig)
-> Parser Bool
-> Parser
     (Bool -> LocMode -> Bool -> Bool -> Bool -> Bool -> RenderConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> Bool -> Mod FlagFields Bool -> Parser Bool
forall a. a -> a -> Mod FlagFields a -> Parser a
flag Bool
False Bool
True (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"show-module-path" 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
"Show a module's filepath instead of its name")
    Parser
  (Bool -> LocMode -> Bool -> Bool -> Bool -> Bool -> RenderConfig)
-> Parser Bool
-> Parser (LocMode -> Bool -> Bool -> Bool -> Bool -> RenderConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> Bool -> Mod FlagFields Bool -> Parser Bool
forall a. a -> a -> Mod FlagFields a -> Parser a
flag Bool
False Bool
True (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"show-child-arrowhead" 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
"Put an arrowhead at the end of a parent-child edge")
    Parser (LocMode -> Bool -> Bool -> Bool -> Bool -> RenderConfig)
-> Parser LocMode
-> Parser (Bool -> Bool -> Bool -> Bool -> RenderConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser LocMode
pLocMode
    Parser (Bool -> Bool -> Bool -> Bool -> RenderConfig)
-> Parser Bool -> Parser (Bool -> Bool -> Bool -> RenderConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> Bool -> Mod FlagFields Bool -> Parser Bool
forall a. a -> a -> Mod FlagFields a -> Parser a
flag Bool
True Bool
False (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"no-cluster-modules" 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
"Don't draw modules as a cluster.")
    Parser (Bool -> Bool -> Bool -> RenderConfig)
-> Parser Bool -> Parser (Bool -> Bool -> RenderConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> Bool -> Mod FlagFields Bool -> Parser Bool
forall a. a -> a -> Mod FlagFields a -> Parser a
flag Bool
True Bool
False (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"no-cluster-trees" 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
"Don't draw definition trees as a cluster.")
    Parser (Bool -> Bool -> RenderConfig)
-> Parser Bool -> Parser (Bool -> RenderConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> Bool -> Mod FlagFields Bool -> Parser Bool
forall a. a -> a -> Mod FlagFields a -> Parser a
flag Bool
True Bool
False (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"no-splines" 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
"Render arrows as straight lines instead of splines")
    Parser (Bool -> RenderConfig) -> Parser Bool -> Parser RenderConfig
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> Bool -> Mod FlagFields Bool -> Parser Bool
forall a. a -> a -> Mod FlagFields a -> Parser a
flag Bool
False Bool
True (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"reverse-dependency-rank" 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
"Make dependencies have lower rank than the dependee, i.e. show dependencies above their parent.")