From f9dc35994f3a50083efe5eaf9e6405e98d49fd40 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 18 Apr 2017 12:11:32 -0400 Subject: smart quoting --- Graphviz.hs | 29 +++++++++++++++++++++++------ 1 file changed, 23 insertions(+), 6 deletions(-) (limited to 'Graphviz.hs') diff --git a/Graphviz.hs b/Graphviz.hs index 6a5cb52..9d508c8 100644 --- a/Graphviz.hs +++ b/Graphviz.hs @@ -52,7 +52,7 @@ genGraph opts ls = digraph (Str "debug-me") $ do where showactivity s (ActivitySeen { activitySeen = (a, h) }) = do node (display h) $ s ++ - [ textLabel $ display $ activity a + [ textLabel $ prettyDisplay $ activity a , shape BoxShape ] case activity a of @@ -69,7 +69,7 @@ genGraph opts ls = digraph (Str "debug-me") $ do linkprev s a h showactivity s (ActivityEntered { activityEntered = (a, h) }) = do node (display h) $ s ++ - [ textLabel $ display $ activity a + [ textLabel $ prettyDisplay $ activity a , shape Circle ] linkprev s a h @@ -78,23 +78,40 @@ genGraph opts ls = digraph (Str "debug-me") $ do Just p -> link p h s link a b s = edge (display a) (display b) $ s ++ if graphvizShowHashes opts - then [ textLabel (shorthash a) ] + then [ textLabel (prettyDisplay a) ] else [] - -- The "h:" prefix is to work around this bug: - -- https://github.com/ivan-m/graphviz/issues/16 - shorthash h = display $ Val $ "h:" <> (B.take 5 $ val $ hashValue h) xcolor :: X11Color -> Attribute xcolor c = Color [toWC $ X11Color c] class Display t where + -- Display more or less as-is, for graphviz. display :: t -> T.Text + -- Prettified display for user-visible labels etc. + prettyDisplay :: t -> T.Text + prettyDisplay = prettyDisplay . display + +instance Display T.Text where + display = id + prettyDisplay t + | all visible s = t + | all isPrint s && not (leadingws s) && not (leadingws (reverse s)) = t + | otherwise = T.pack (show s) + where + s = T.unpack t + visible c = isPrint c && not (isSpace c) + leadingws (c:_) = isSpace c + leadingws _ = False instance Display Val where display (Val b) = T.decodeUtf8With lenientDecode (L.fromStrict b) instance Display Hash where display (Hash m h) = T.pack (show m) <> display h + -- Use short hash for pretty display. + -- The "h:" prefix is to work around this bug: + -- https://github.com/ivan-m/graphviz/issues/16 + prettyDisplay h = display $ Val $ "h:" <> (B.take 5 $ val $ hashValue h) instance Display Seen where display = display . seenData -- cgit v1.2.3