e213ef310f
* Fix minor FD leak in journal code. Closes: #754608 * direct: Fix handling of case where a work tree subdirectory cannot be written to due to permissions. * migrate: Avoid re-checksumming when migrating from hashE to hash backend. * uninit: Avoid failing final removal in some direct mode repositories due to file modes. * S3: Deal with AWS ACL configurations that do not allow creating or checking the location of a bucket, but only reading and writing content to it. * resolvemerge: New plumbing command that runs the automatic merge conflict resolver. * Deal with change in git 2.0 that made indirect mode merge conflict resolution leave behind old files. * sync: Fix git sync with local git remotes even when they don't have an annex.uuid set. (The assistant already did so.) * Set gcrypt-publish-participants when setting up a gcrypt repository, to avoid unncessary passphrase prompts. This is a security/usability tradeoff. To avoid exposing the gpg key ids who can decrypt the repository, users can unset gcrypt-publish-participants. * Install nautilus hooks even when ~/.local/share/nautilus/ does not yet exist, since it is not automatically created for Gnome 3 users. * Windows: Move .vbs files out of git\bin, to avoid that being in the PATH, which caused some weird breakage. (Thanks, divB) * Windows: Fix locking issue that prevented the webapp starting (since 5.20140707). # imported from the archive
63 lines
1.7 KiB
Haskell
63 lines
1.7 KiB
Haskell
{- a simple graphviz / dot(1) digraph description generator library
|
|
-
|
|
- Copyright 2010 Joey Hess <joey@kitenet.net>
|
|
-
|
|
- License: BSD-2-clause
|
|
-}
|
|
|
|
module Utility.Dot where -- import qualified
|
|
|
|
{- generates a graph description from a list of lines -}
|
|
graph :: [String] -> String
|
|
graph s = unlines $ [header] ++ map indent s ++ [footer]
|
|
where
|
|
header = "digraph map {"
|
|
footer= "}"
|
|
|
|
{- a node in the graph -}
|
|
graphNode :: String -> String -> String
|
|
graphNode nodeid desc = label desc $ quote nodeid
|
|
|
|
{- an edge between two nodes -}
|
|
graphEdge :: String -> String -> Maybe String -> String
|
|
graphEdge fromid toid desc = indent $ maybe edge (`label` edge) desc
|
|
where
|
|
edge = quote fromid ++ " -> " ++ quote toid
|
|
|
|
{- adds a label to a node or edge -}
|
|
label :: String -> String -> String
|
|
label = attr "label"
|
|
|
|
{- adds an attribute to a node or edge
|
|
- (can be called multiple times for multiple attributes) -}
|
|
attr :: String -> String -> String -> String
|
|
attr a v s = s ++ " [ " ++ a ++ "=" ++ quote v ++ " ]"
|
|
|
|
{- fills a node with a color -}
|
|
fillColor :: String -> String -> String
|
|
fillColor color s = attr "fillcolor" color $ attr "style" "filled" s
|
|
|
|
{- apply to graphNode to put the node in a labeled box -}
|
|
subGraph :: String -> String -> String -> String -> String
|
|
subGraph subid l color s =
|
|
"subgraph " ++ name ++ " {\n" ++
|
|
ii setlabel ++
|
|
ii setfilled ++
|
|
ii setcolor ++
|
|
ii s ++
|
|
indent "}"
|
|
where
|
|
-- the "cluster_" makes dot draw a box
|
|
name = quote ("cluster_" ++ subid)
|
|
setlabel = "label=" ++ quote l
|
|
setfilled = "style=" ++ quote "filled"
|
|
setcolor = "fillcolor=" ++ quote color
|
|
ii x = indent (indent x) ++ "\n"
|
|
|
|
indent ::String -> String
|
|
indent s = '\t' : s
|
|
|
|
quote :: String -> String
|
|
quote s = "\"" ++ s' ++ "\""
|
|
where
|
|
s' = filter (/= '"') s
|