calligraphy 0.1.7 → 0.1.8

raw patch · 5 files changed

+49/−8 lines, 5 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +9/−0
• calligraphy.cabal +1/−1
• src/Calligraphy.hs +1/−1
• src/Calligraphy/Phases/Render/GraphViz.hs +22/−3
• src/Calligraphy/Util/Types.hs +16/−3

@@ -1,5 +1,14 @@ # Changelog +## 0.1.8+### [Changed]+- [#49] Make the background of modules tinted.+- [#52] Reword the error message if no files are found to instruct the user to build with -fwrite-ide-info++### [Added]+- [#47] Add landscape layout feature.+- [#48] Add orthogonal edges feature.+ ## 0.1.7 ### [Added] - [#46] GHC 9.8, 9.10 support

@@ -1,6 +1,6 @@ cabal-version:   2.4 name:            calligraphy-version:         0.1.7+version:         0.1.8 license:         BSD-3-Clause build-type:      Simple license-file:    LICENSE

@@ -49,7 +49,7 @@       debug fp printer = when (fp debugConfig) (printStderr printer)    hieFiles <- searchFiles searchConfig-  when (null hieFiles) $ die "No files matched your search criteria.."+  when (null hieFiles) $ die "No .hie files matched your search criteria. Did you build with `-fwrite-ide-info`?"   debug dumpHieFile $ mapM_ ppHieFile hieFiles    (parsePhaseDebug, cgParsed) <- either (printDie . ppParseError) pure (parseHieFiles hieFiles)

@@ -18,12 +18,25 @@ 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,-    splines :: Bool,+    leftToRight :: Bool,+    splines :: Splines,     reverseDependencyRank :: Bool   } @@ -32,13 +45,18 @@   GraphVizConfig     <$> 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 True False (long "no-splines" <> help "Render arrows as straight lines instead of splines")+    <*> flag False True (long "left-to-right" <> help "Draw the tree from left to right.")+    <*> 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];"     case roots of@@ -73,6 +91,7 @@     printModule (RenderModule lbl modId trees) =       brack ("subgraph cluster_module_" <> modId <> " {") "}" $ do         strLn $ "label=" <> show lbl <> ";"+        strLn "bgcolor=\"whitesmoke\""         forM_ trees printTree      printNode :: Prints RenderNode

@@ -104,11 +104,24 @@     mempty  ppCallGraph :: Prints CallGraph-ppCallGraph (CallGraph modules _ _) = forM_ modules $ \(Module modName modPath forest) -> do-  strLn $ modName <> " (" <> modPath <> ")"-  indent $ mapM_ ppTree forest+ppCallGraph (CallGraph modules calls types) = do+  forM_ modules $ \(Module modName modPath forest) -> do+    strLn $ modName <> " (" <> modPath <> ")"+    indent $ mapM_ ppTree forest+  let edgeArrows = Set.map showCall calls <> Set.map showType types+  forM_ edgeArrows strLn+    where+      table = makeDeclarationLookupTable (concatMap moduleForest modules)+      nameOfKey = declName . (EnumMap.!) table+      showCall (from, to) = nameOfKey from <> " ---> " <> nameOfKey to+      showType (from, to) = nameOfKey from <> " ···> " <> nameOfKey to  ppTree :: Prints (Tree Decl) ppTree (Node (Decl name _key _ghckey _exp typ loc) children) = do   strLn $ name <> " (" <> show typ <> ", " <> show loc <> ")"   indent $ mapM_ ppTree children++makeDeclarationLookupTable :: Forest Decl -> EnumMap Key Decl+makeDeclarationLookupTable = (foldMap . foldMap) makeSingletonMap+  where+    makeSingletonMap declaration = EnumMap.singleton (declKey declaration) declaration