tracetree 0.1.0.0 → 0.1.0.1

raw patch · 7 files changed

+183/−63 lines, 7 filesdep ~bifunctorsdep ~optparse-applicativedep ~transformersPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: bifunctors, optparse-applicative, transformers

API changes (from Hackage documentation)

Files

• ChangeLog.md +8/−0
• src/Debug/Trace/Tree/Edged.hs +52/−15
• src/Debug/Trace/Tree/Rose.hs +14/−11
• tracetree.cabal +11/−4
• ttrender/Debug/Trace/Tree/Render/Edged.hs +1/−1
• ttrender/Debug/Trace/Tree/Render/Options.hs +95/−30
• ttrender/Debug/Trace/Tree/Render/Simple.hs +2/−2

@@ -0,0 +1,8 @@+0.1.0.1+-------+* Improved language for hiding nodes+* Lifted upper bounds++0.1.0.0+-------+* Initial release

@@ -11,6 +11,8 @@   , keys   , mapEdges     -- * Hiding nodes+  , MatchAgainst(..)+  , NodeSpec(..)   , Hide(..)   , hideNodes     -- * Annotation@@ -18,6 +20,7 @@   , Offset   , Coords(..)   , Metadata(..)+  , Rose.isFirstChild   , annotate     -- * Interaction between ETree and Tree   , pushEdges@@ -89,28 +92,62 @@   Hiding nodes -------------------------------------------------------------------------------} +-- | Abstract definition of something we can match against a value+class MatchAgainst v m where+    matchAgainst :: v -> m -> Bool++-- | Various ways we can specify a node+data NodeSpec v =+    -- | Node at the specified coordinates+    NodeCoords Coords++    -- | Match the value of the node+  | forall m. (MatchAgainst v m, Show m) => NodeMatch m++matchSpec :: NodeSpec v -> (v, Metadata) -> Bool+matchSpec (NodeCoords c) (_, Metadata{..}) = c == coords+matchSpec (NodeMatch  m) (v, _)            = v `matchAgainst` m+ -- | Specification of nodes to hide-data Hide =-    -- | Hide the node at the specified coordinates-    HideNode Coords+data Hide v =+    -- | Hide the specified node+    HideNode (NodeSpec v) -instance Show Hide where-    show (HideNode Coords{..}) = "node(" ++ show depth ++ "," ++ show offset ++ ")"+    -- | Limit the range of children of the specified node+  | HideMax (Int, Int) (NodeSpec v) +instance Show (NodeSpec v) where+    show (NodeCoords Coords{..}) = show depth ++ "," ++ show offset+    show (NodeMatch  m)          = show m++instance Show (Hide v) where+    show (HideNode  spec) = "node(" ++ show spec ++ ")"+    show (HideMax n spec) = "max(" ++ show n ++ "," ++ show spec ++ ")"+ -- | Check if a certain node should be hidden-isHidden :: [Hide] -> Metadata -> Bool-isHidden spec Metadata{..} = any hides spec+isHidden :: forall v.+            [Hide v]            -- ^ User-specified rules for hiding nodes+         -> Maybe (v, Metadata) -- ^ Parent node+         -> (v, Metadata)       -- ^ This node+         -> Bool+isHidden rules mParent this@(_, Metadata{..}) =+    any (hides mParent) rules   where-    hides :: Hide -> Bool-    hides (HideNode coords') = coords == coords'+    hides :: Maybe (v, Metadata) -> Hide v -> Bool+    hides _             (HideNode  spec) = matchSpec spec this+    hides (Just parent) (HideMax r spec) = matchSpec spec parent && not (inRange r nthChild)+    hides Nothing       (HideMax _ _)    = False -hideNodes :: forall k v. [Hide] -> ETree k (v, Metadata) -> ETree k (Maybe v, Metadata)-hideNodes spec = go+    inRange :: (Int, Int) -> Int -> Bool+    inRange (lo, hi) n = lo <= n && n <= hi++hideNodes :: forall k v. [Hide v] -> ETree k (v, Metadata) -> ETree k (Maybe v, Metadata)+hideNodes spec = go Nothing   where-    go :: ETree k (v, Metadata) -> ETree k (Maybe v, Metadata)-    go (Node (v, meta) (Assoc ts))-      | isHidden spec meta = Node (Nothing , meta) $ Assoc []-      | otherwise          = Node (Just v  , meta) $ Assoc (map (second go) ts)+    go :: Maybe (v, Metadata) -> ETree k (v, Metadata) -> ETree k (Maybe v, Metadata)+    go mParent (Node (v, meta) (Assoc ts))+      | isHidden spec mParent (v, meta) = Node (Nothing, meta) $ Assoc []+      | otherwise = Node (Just v, meta) $ Assoc (map (second (go (Just (v, meta)))) ts)  {-------------------------------------------------------------------------------   Interaction between ETree and Tree

@@ -5,6 +5,7 @@   , Offset   , Coords(..)   , Metadata(..)+  , isFirstChild   , annotate   ) where @@ -68,12 +69,15 @@  -- | Metadata of a node in the tree data Metadata = Metadata {-      isSpine      :: Bool-    , isFirstChild :: Bool-    , coords       :: Coords+      isSpine  :: Bool+    , nthChild :: Int+    , coords   :: Coords     }   deriving (Show, Eq, Ord) +isFirstChild :: Metadata -> Bool+isFirstChild Metadata{..} = nthChild == 0+ {-------------------------------------------------------------------------------   Auxiliary: operations on trees -------------------------------------------------------------------------------}@@ -87,12 +91,11 @@                            $ map (uncurry go) $ zip (isSpine : repeat False) ts  -- | Mark the first child of each node-markFirstChild :: Tree a -> Tree (a, Bool)-markFirstChild = go True+markNthChild :: Tree a -> Tree (a, Int)+markNthChild = go 0   where-    go :: Bool -> Tree a -> Tree (a, Bool)-    go isFirst (Node a ts) = Node (a, isFirst)-                           $ map (uncurry go) $ zip (True : repeat False) ts+    go :: Int -> Tree a -> Tree (a, Int)+    go nth (Node a ts) = Node (a, nth) $ zipWith go [0..] ts  -- | Mark each node with its depth in the tree markDepth :: Tree a -> Tree (a, Depth)@@ -117,11 +120,11 @@ annotate :: Tree a -> Tree (a, Metadata) annotate = fmap aux          . markCoords-         . markFirstChild+         . markNthChild          . markSpine   where-    aux :: (((a, Bool), Bool), Coords) -> (a, Metadata)-    aux (((a, isSpine), isFirstChild), coords) = (a, Metadata{..})+    aux :: (((a, Bool), Int), Coords) -> (a, Metadata)+    aux (((a, isSpine), nthChild), coords) = (a, Metadata{..})  {-------------------------------------------------------------------------------   Debugging

@@ -1,5 +1,5 @@ name:                tracetree-version:             0.1.0.0+version:             0.1.0.1 synopsis:            Visualize Haskell data structures as edge-labeled trees description:         The tracetree library can be used to conveniently write                      Haskell data structures as trees represented as JSON@@ -18,7 +18,7 @@                      dependency on tracetree to your project, you can just                      generate the .JSON files directly in your code; the format                      is not complicated (indeed, you can create them by hand-                     or post-process previously exported .JSON files). +                     or post-process previously exported .JSON files). license:             BSD3 license-file:        LICENSE author:              Edsko de Vries@@ -29,6 +29,9 @@ -- extra-source-files: cabal-version:       >=1.10 +extra-source-files:+  ChangeLog.md+ source-repository head   type: git   location: https://github.com/edsko/tracetree@@ -47,7 +50,7 @@   -- We need ghc 7.10 (using bidrectional pattern synonyms),   -- but I don't know how to specify that other through the version of base   build-depends:       base         >= 4.8 && < 5,-                       bifunctors   >= 4.2 && < 4.3,+                       bifunctors   >= 4.2 && < 5.3,                        containers   >= 0.5 && < 0.6,                        json         >= 0.9 && < 0.10,                        mtl          >= 2.2 && < 2.3,@@ -56,8 +59,10 @@   default-language:    Haskell2010   ghc-options:         -Wall   default-extensions:  DefaultSignatures+                       ExistentialQuantification                        FlexibleContexts                        FlexibleInstances+                       MultiParamTypeClasses                        NoMonomorphismRestriction                        ParallelListComp                        PatternSynonyms@@ -80,7 +85,7 @@     build-depends:     base                 >= 4.8  && < 5,                        colour               >= 2.3  && < 2.4,                        json                 >= 0.9  && < 0.10,-                       optparse-applicative >= 0.11 && < 0.12,+                       optparse-applicative >= 0.11 && < 0.13,                        regex-posix          >= 0.95 && < 0.96,                        parsec               >= 3.1  && < 3.2,                        diagrams-cairo       >= 1.3  && < 1.4,@@ -96,6 +101,8 @@   default-language:    Haskell2010   default-extensions:  BangPatterns                        FlexibleContexts+                       FlexibleInstances+                       MultiParamTypeClasses                        NoMonomorphismRestriction                        PatternSynonyms                        RecordWildCards

@@ -36,7 +36,7 @@          drV :: (v, Metadata) -> (Diagram B, Metadata)         drV (v, meta) =-          let rendered | showCoords = drV' v <> renderCoords (coords meta)+          let rendered | showCoords = renderCoords (coords meta) <> drV' v                        | otherwise  = drV' v           in (rendered, meta) 

@@ -1,6 +1,6 @@ -- | Render simple trees {-# OPTIONS_GHC -fno-warn-unused-do-bind #-}-module Debug.Trace.Tree.Render.Options (RenderOptions(..), applyOptions) where+module Debug.Trace.Tree.Render.Options where -- (RenderOptions(..), applyOptions) where  import Data.Bifunctor import Data.Colour (Colour)@@ -10,19 +10,35 @@ import Data.Function (on) import Diagrams.Backend.CmdLine (Parseable(..)) import Options.Applicative+import Text.Regex.Posix ((=~)) import qualified Text.Parsec        as Parsec import qualified Text.Parsec.String as Parsec  import Debug.Trace.Tree.Simple (SimpleTree, simpleETree)-import Debug.Trace.Tree.Edged (ETree, Hide(..), Metadata, Coords(..))+import Debug.Trace.Tree.Edged import Debug.Trace.Tree.Assoc (Assoc(..))-import qualified Debug.Trace.Tree.Edged  as Edged import qualified Debug.Trace.Tree.Simple as Simple +{-------------------------------------------------------------------------------+  Matching nodes+-------------------------------------------------------------------------------}++data RegExp = RegExp String++instance Show RegExp where+    show (RegExp regExp) = regExp++instance MatchAgainst String RegExp where+    s `matchAgainst` (RegExp regExp) = s =~ regExp++{-------------------------------------------------------------------------------+  Command line args proper+-------------------------------------------------------------------------------}+ data RenderOptions = RenderOptions {-    renderHideNodes    :: [Hide]+    renderHideNodes    :: [Hide String]   , renderMerge        :: [String]-  , renderVertical     :: [String]+  , renderVertical     :: [RegExp]   , renderColours      :: [(String, Colour Double)]   , renderMaxNotShown  :: Int   , renderDelChildren  :: [String]@@ -32,17 +48,30 @@  instance Parseable RenderOptions where   parser = RenderOptions-    <$> ( many (option readHide $ mconcat [+    <$> ( many (option (readParsec parseHide) $ mconcat [             long "hide"           , metavar "HIDE"-          , help "Hide certain nodes in the tree; arrows to these nodes are shown as dangling (modulo the max-not-shown option). Valid syntax for the argument is: \"node(y,x)\": Hide the node at the specified level. Can be used multiple times."+          , help $ unlines [+                "Hide certain nodes in the tree; arrows to these nodes are shown as dangling (modulo the max-not-shown option)."+              , "Can be used multiple times."+              , ""+              , "Valid syntax for the argument is: "+              , "  \"node(SPEC)\": Hide all nodes matching SPEC."+              , "  \"max(RANGE,SPEC)\": Only show the children in RANGE of nodes matching SPEC."+              , ""+              , "Where SPEC is: "+              , "  \"y,x\": Node at specific coordinates"+              , "  REGEXP: Any node matching REGEXP"+              , ""+              , "RANGE is n-m, n-, or -m"+              ]           ]))     <*> ( many (strOption $ mconcat [             long "merge"           , metavar "C"           , help "Collapse any tree of shape (C' .. (C args) ..) to (C' .. args ..). Can be used multiple times."           ]))-    <*> ( many (strOption $ mconcat [+    <*> ( many (option (readParsec parseRegExp) $ mconcat [             long "vertical"           , metavar "REGEXP"           , help "Show any node matching the specified regular expression vertically. Can be used multiple times."@@ -68,12 +97,12 @@            ])     <*> ( argument str (metavar "JSON") ) -readHide :: ReadM Hide-readHide = do+readParsec :: Parsec.Parser a -> ReadM a+readParsec p = do     arg <- str-    case Parsec.parse parseHide "HIDE" arg of-      Left  err  -> fail (show err)-      Right hide -> return hide+    case Parsec.parse p "command line argument" arg of+      Left  err -> fail (show err)+      Right a   -> return a  readColourAssignment :: ReadM (String, Colour Double) readColourAssignment = do@@ -85,8 +114,8 @@ applyOptions :: RenderOptions -> SimpleTree -> ETree String (Maybe String, Metadata) applyOptions RenderOptions{..} =       applyMaxNotShown renderMaxNotShown-    . Edged.hideNodes renderHideNodes-    . Edged.annotate+    . hideNodes renderHideNodes+    . annotate     . simpleETree     . applyMerge renderMerge     . applyDelChildren renderDelChildren@@ -110,9 +139,9 @@     go _ = error "inaccessible"  applyMaxNotShown :: Int -> ETree String (Maybe String, Metadata) -> ETree String (Maybe String, Metadata)-applyMaxNotShown n = \(Edged.Node c (Assoc ts)) ->+applyMaxNotShown n = \(Node c (Assoc ts)) ->     let culled = concatMap aux (groupBy ((==) `on` isShown) ts)-    in Edged.Node c $ fmap (applyMaxNotShown n) (Assoc culled)+    in Node c $ fmap (applyMaxNotShown n) (Assoc culled)   where     -- Replace each group of hidden nodes with an ellipsis (if larger than n)     -- We re-use the node metadata of the first node in the group@@ -124,26 +153,62 @@       | otherwise                        = ts      ellipsis :: Metadata -> (String, ETree String (Maybe String, Metadata))-    ellipsis meta = ("...", Edged.Node (Nothing, meta) (Assoc []))+    ellipsis meta = ("...", Node (Nothing, meta) (Assoc []))      isShown :: (String, ETree String (Maybe String, meta)) -> Bool-    isShown (_key, (Edged.Node (c', _coords) _subtree)) = isJust c'+    isShown (_key, (Node (c', _coords) _subtree)) = isJust c'      rootMeta :: ETree k (v, Metadata) -> Metadata-    rootMeta (Edged.Node (_, meta) _) = meta+    rootMeta (Node (_, meta) _) = meta  {-------------------------------------------------------------------------------   Parser for Hide -------------------------------------------------------------------------------} -parseHide :: Parsec.Parser Hide-parseHide = parseHideNode+parseHide :: Parsec.Parser (Hide String)+parseHide =+      (do Parsec.try $ Parsec.string "node("+          s <- parseNodeSpec+          Parsec.string ")"+          return $ HideNode s)+  <|> (do Parsec.try $ Parsec.string "max("+          lo <- parseInt+          Parsec.string "-"+          hi <- parseInt+          Parsec.string ","+          s <- parseNodeSpec+          Parsec.string ")"+          return $ HideMax (lo, hi) s) -parseHideNode :: Parsec.Parser Hide-parseHideNode = do-    Parsec.string "node("-    y <- Parsec.many1 Parsec.digit-    Parsec.string ","-    x <- Parsec.many1 Parsec.digit-    Parsec.string ")"-    return $ HideNode $ Coords (read y) (read x)+parseNodeSpec :: Parsec.Parser (NodeSpec String)+parseNodeSpec =+    Parsec.try (do y <- parseInt+                   Parsec.string ","+                   x <- parseInt+                   return $ NodeCoords $ Coords y x)+  <|>+    (NodeMatch <$> parseRegExp)++parseInt :: Parsec.Parser Int+parseInt = read <$> Parsec.many1 Parsec.digit++-- | Regular expression delimited by an unmatched closing parenthesis+parseRegExp :: Parsec.Parser RegExp+parseRegExp = RegExp <$> matchBrackets++{-------------------------------------------------------------------------------+  Auxiliary parsec+-------------------------------------------------------------------------------}++-- | Match as much as possible, until we see an unexpected closing parenthesis+matchBrackets :: Parsec.Parser String+matchBrackets = go 0+  where+    go :: Int -> Parsec.Parser String+    go nestingDepth = (do+      x  <- if nestingDepth > 0 then Parsec.anyChar else Parsec.noneOf ")"+      let nestingDepth' | x == '('  = nestingDepth + 1+                        | x == ')'  = nestingDepth - 1+                        | otherwise = nestingDepth+      xs <- go nestingDepth'+      return (x:xs)) <|> return ""

@@ -5,8 +5,8 @@ import Diagrams.Backend.Cairo (B) import Graphics.SVGFonts import Graphics.SVGFonts.ReadFont (PreparedFont)-import Text.Regex.Posix ((=~)) +import Debug.Trace.Tree.Edged (matchAgainst) import Debug.Trace.Tree.Simple import Debug.Trace.Tree.Render.Options import Debug.Trace.Tree.Render.Constants@@ -26,7 +26,7 @@     makeBox Nothing    = mempty      maybeVertical Nothing    = id-    maybeVertical (Just str) = if any (\regexp -> str =~ regexp) renderVertical+    maybeVertical (Just str) = if any (matchAgainst str) renderVertical                                  then rotateBy (1/4)                                  else id