Skip to content

Add orthogonal edges feature. #48

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
kindaro merged 1 commit into from
Apr 23, 2025
Merged

Add orthogonal edges feature. #48

Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
21 changes: 18 additions & 3 deletions src/Calligraphy/Phases/Render/GraphViz.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -18,13 +18,25 @@ import Data.Maybe (catMaybes)
import Data.Tree (Tree)
import qualified Data.Tree as Tree
import Options.Applicative hiding (style)
import Options.Applicative.Types
import Text.Show (showListWith)

data Splines = Curved | Straight | Orthogonal

spline :: ReadM Splines
spline = do
string <- readerAsk
case string of
"curved" -> pure Curved
"straight" -> pure Straight
"orthogonal" -> pure Orthogonal
_ -> readerError $ "Wrong argument: '" <> string <> "'.\nMust be either 'curved', 'straight' or 'orthogonal'."

data GraphVizConfig = GraphVizConfig
{ showChildArrowhead :: Bool,
clusterGroups :: Bool,
leftToRight :: Bool,
splines :: Bool,
splines :: Splines,
reverseDependencyRank :: Bool
}

Expand All @@ -34,13 +46,16 @@ pGraphVizConfig =
<$> flag False True (long "show-child-arrowhead" <> help "Put an arrowhead at the end of a parent-child edge")
<*> flag True False (long "no-cluster-trees" <> help "Don't draw definition trees as a cluster.")
<*> flag False True (long "left-to-right" <> help "Draw the tree from left to right.")
<*> flag True False (long "no-splines" <> help "Render arrows as straight lines instead of splines")
<*> option spline (long "splines" <> help "Set shape of splines; can be 'curved', 'straight' or 'orthogonal'." <> value Curved)
<*> flag False True (long "reverse-dependency-rank" <> help "Make dependencies have lower rank than the dependee, i.e. show dependencies above their parent.")

renderGraphViz :: GraphVizConfig -> Prints RenderGraph
renderGraphViz GraphVizConfig {..} (RenderGraph roots calls types) = do
brack "digraph calligraphy {" "}" $ do
unless splines $ textLn "splines=false;"
case splines of
Curved -> pure ()
Straight -> textLn "splines=false"
Orthogonal -> textLn "splines=ortho"
when leftToRight $ textLn "rankdir=\"RL\";"
textLn "node [style=filled fillcolor=\"#ffffffcf\"];"
textLn "graph [outputorder=edgesfirst];"
Expand Down
Loading